Related
I am making a sort of population pyramid using ggplot (plotrix doesn't allow me to do fancy labels etc), then I start with a geom_bar with labels and later I flip the coordinates. Sadly, labels almost cannot being seeing. I would like to move those labels near to the "y- axis" in the middle, that now is showing the age groups.
Data is here: d <- data.frame(age.grp2 = c("1-10", "11-20", "21-30", "31-40", "41-50", "1-10", "11-20", "21-30", "31-40", "41-50"),
sex = c("Female","Female","Female","Female","Female","Male","Male","Male","Male","Male" ),
n.enroll = c(288,500,400,300,200,300,460,300,200,300),
proportion = c(17.1,29.6,23.7,17.8,11.8,51,47.9,42.9,40,60),
proportion2 = c(-17.1,-29.6,-23.7,-17.8,-11.8,51,47.9,42.9,40,60)) My code is this one: ggplot(d, aes(x = age.grp2, y = proportion2, fill = sex)) +
geom_bar(position = position_dodge(width=1), stat='identity') +
geom_label(aes(label = paste(n.enroll," (",proportion,"%)", sep=""), group = factor(sex)),
fill="white", colour = "black",
position= position_dodge(width=1),
size = 3) +
scale_fill_manual(values=c("#BFD5E3", "grey")) +
facet_share(~sex, dir = "h", scales = "free", reverse_num = TRUE) +
coord_flip() +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
#panel.border = element_blank(),
panel.background = element_blank(),
legend.position = "none",
#axis.line.x = element_line(color = "black"),
axis.ticks.y = element_blank(),
axis.text.x = element_text(colour = "black", size = 8, face = "bold", angle=0, hjust=0.5),
axis.text.y = element_text(colour = "black", size = 8, face = "bold"),
axis.title.x = element_text(size = 14, face="bold", margin = margin(t = 30, r = 20, b = 10, l = 20)),
plot.margin = unit(c(1,1,1,1),"cm")) +
labs(y = "Enrollment percentage within sex",x="") I am attaching also the plot, where we can see in females the label in the age group 11-20 is cut. I would like to have all labels near to the age group labels, within each bar: female labels moved to the right and male labels move it to the left. Also, I would like to have each x-axis extended to 100% or at least in same range, in females goes up to 30% and in males goes up to 60%. Thanks for all the comments
Here's a minimal solution using the base ggplot package, without most of your formatting. The key part is to add a conditional y = ... into the geom_label(aes()) section:
d %>%
mutate(
label = str_c(n.enroll, " (", proportion, "%)"),
label_loc = if_else(sex == "Female", -9.5, 3),
proportion_for_chart = if_else(sex == "Female", -proportion, proportion)
) %>%
ggplot(aes(x = age.grp2, y = proportion_for_chart, fill = sex)) +
geom_col(show.legend = FALSE) +
geom_label(aes(y = label_loc, label = label), size = 3, fill = "white", hjust = 0) +
coord_flip() +
facet_wrap(~ sex, scales = "free") +
theme(
axis.title = element_blank()
)
Whenever possible, I try to reshape data and use geom_col rather than try to get lucky with geom_bar. You should be able to play around with different hard-coded values of y in the geom_label call to fix the proper location for your labels based on your formatting and image size/scale.
For the past hours I have tried to understand the whole design/theme/labelling concept around ggalluvial, but I failed.
Within minutes I was able to produce the kind of graph I want (thanks to the package ggalluvial), but I can't figure how to produce the correct labelling/theme I'd like to have.
This is where I am currently:
This is where I was initially:
To get you to understand where I am, here's a reproducible example
I used the following code:
library(ggalluvial)
ds <- as.data.frame(Titanic)
ggplot(ds,
aes(weight = Freq, axis1 = Sex, axis2 = Class)) +
geom_alluvium(aes(fill = Sex), width = 1/12) +
geom_stratum(width = 1/4, fill = "black", color = "grey") +
scale_x_continuous(breaks = 1:2, labels = c("Sex", "Class")) +
scale_fill_manual(name = "", values=c("#A0A0A0", "#494949")) +
ggtitle("Titanic Survival") +
theme_bw() +
geom_text(stat = "stratum", color="white",label.strata = TRUE,
angle=c(90,90,0,0,0,0) , size=6,
nudge_y=c(1,2,3,4,5,0)) +
theme(legend.position = "bottom",
title = element_text(size = 20),
legend.text = element_text(size = 20),
axis.text.y = element_blank(),
axis.text.x = element_text(size=20))
What I would like to change:
turn labels on the left vertically
done
make labels on the right not overlap (not visible with the Titanic data)
I tried nudging. But it may be more useful to place these legends outside the graph, maybe like on an axis?
remove y-axis labels
done
Understand with what command I can change each of the text elements size (title, legend, labels, axis labels)
dome
I am very happy for any help on this. Thank you.
You can try:
ggplot(ds,
aes(weight = Freq, axis1 = Sex, axis2 = Class)) +
geom_alluvium(aes(fill = Sex), width = 1/12) +
geom_stratum(width = 1/16, fill = "black", color = "grey") +
scale_x_continuous(breaks = 1:2, labels = c("Sex", "Class")) +
scale_fill_manual(name = "", values=c("#A0A0A0", "#494949")) +
ggtitle("Titanic Survival") +
theme_bw() +
geom_text(stat = "stratum", color="red",label.strata = TRUE, angle=c(0,0,45,45,45,45),size=5) +
theme(legend.position = "bottom",
title = element_text(size = 20),
legend.text = element_text(size = 20),
axis.text.y = element_blank(),
axis.text.x = element_text(size=20))
add a vector with the same length of labels like angle=c(0,0,45,45,45,45)
add axis.text.y = element_blank() in theme()
pending
Sizes via theme
via theme() such as x-axis labels
text in plot via size=5 in geom_text()
Considering the following data, I am able to generate a plot which describes how the risk of a react over a time interval changes.
risk_1 <- c(0.121,0.226,0.333,0.167,0.200,0.273,0.138,0.323,0.394,0.250,0.200,0.545,0.190,0.355,0.515,0.333,0.300,0.818)
risk_minus_SE <- c(0.060,0.114,0.198,0.047,0.057,0.097,0.072,0.186,0.247,0.089,0.057,0.280,0.109,0.211,0.352,0.138,0.108,0.523)
risk_plus_SE <- c(0.229,0.398,0.504,0.448,0.510,0.566,0.249,0.499,0.563,0.532,0.510,0.787,0.309,0.531,0.675,0.609,0.603,0.949)
Status <- rep(c(rep('With placebo',3),rep('With drug',3)),3)
durtn <- rep(c('(3-15]','(15-30]','(30-46]'),6)
react <- c(rep("x\u226516",6),rep("x\u226509",6),rep("x\u226504",6))
df1 <- data.frame(risk_1, risk_minus_SE, risk_plus_SE, Status, durtn, react)
dodge <- position_dodge(width=0.45)
ggplot(df1,aes(colour=react, y=risk_1, x=durtn)) +
geom_point(aes(shape=durtn), shape=16, size = 5, position=dodge) +
geom_errorbar(aes(ymin=risk_minus_SE, ymax=risk_plus_SE), position = dodge, width=0.5, size=1, lty=1) +
scale_colour_manual(values = c('black','red','blue')) +
facet_grid(~Status) +
scale_shape_manual(values = c(8,19))+
theme_bw() +
scale_x_discrete(limits=c('(3-15]','(15-30]','(30-46]')) +
coord_cartesian(ylim = c(0, 0.8)) +
theme(legend.position = c(.1, .85), legend.background = element_rect(colour = "black"),
plot.title = element_text(lineheight=1.5, face="bold", size=rel(1.5), hjust = 0.5),
panel.grid.major.x = element_blank(),
axis.text.x = element_text(vjust=0.5, size=16),
axis.text.y = element_text(vjust=0.5, size=16),
axis.title.y = element_text(size=20),
axis.title.x = element_text(size=20),
legend.text = element_text(size = 16, face = "bold"),
strip.text = element_text(size=25)) +
xlab("\ntime (min)") + ylab("Risk")
What I want to do is overlay a series of points at given x and y coordinates.
That being at With drug & durtn==(3,15], manually insert points at.....
Risk==0.5 for react=x≥04 in black
Risk==0.2 for react=x≥09 in red
Risk==0.0 for react=x≥16 in blue
Such that the desired output should look like
How does one use the geom_point() in combination with a facet_grid and dodge
First, you have to create a separate data frame that contains the data for the additional points.
dat <- data.frame(risk_1 = c(0.5, 0.2, 0),
react = levels(df1$react),
durtn = '(3-15]',
Status = 'With drug')
This new data frame dat can be used with geom_point to add an additional layer to the existing plot.
+ geom_point(data = dat, position = dodge, shape = 4, size = 5, show.legend = FALSE)
I'm trying to plot a 2D density plot with ggplot, with added marginal histograms. Problem is that the polygon rendering is stupid and needs to be given extra padding to render values outside your axis limits (e.g. in this case I set limits between 0 and 1, because values outside this range have no physical meaning). I still want the density estimate though, because often it's much cleaner than a blocky 2D heatmap.
Is there a way around this problem, besides scrapping ggMarginal entirely and spending another 50 lines of code trying to align histograms?
Unsightly lines:
Now rendering works, but ggMarginal ignores choord_cartesian(), which demolishes the plot:
Data here:
http://pasted.co/b581605a
dataset <- read.csv("~/Desktop/dataset.csv")
library(ggplot2)
library(ggthemes)
library(ggExtra)
plot_center <- ggplot(data = dataset, aes(x = E,
y = S)) +
stat_density2d(aes(fill=..level..),
bins= 8,
geom="polygon",
col = "black",
alpha = 0.5) +
scale_fill_continuous(low = "yellow",
high = "red") +
scale_x_continuous(limits = c(-1,2)) + # Render padding for polygon
scale_y_continuous(limits = c(-1,2)) + #
coord_cartesian(ylim = c(0, 1),
xlim = c(0, 1)) +
theme_tufte(base_size = 15, base_family = "Roboto") +
theme(axis.text = element_text(color = "black"),
panel.border = element_rect(colour = "black", fill=NA, size=1),
legend.text = element_text(size = 12, family = "Roboto"),
legend.title = element_blank(),
legend.position = "none")
ggMarginal(plot_center,
type = "histogram",
col = "black",
fill = "orange",
margins = "both")
You can solve this problem by using xlim() and ylim() instead of coord_cartesian.
dataset <- read.csv("~/Desktop/dataset.csv")
library(ggplot2)
library(ggthemes)
library(ggExtra)
plot_center <- ggplot(data = dataset, aes(x = E,
y = S)) +
stat_density2d(aes(fill=..level..),
bins= 8,
geom="polygon",
col = "black",
alpha = 0.5) +
scale_fill_continuous(low = "yellow",
high = "red") +
scale_x_continuous(limits = c(-1,2)) + # Render padding for polygon
scale_y_continuous(limits = c(-1,2)) + #
xlim(c(0,1)) +
ylim(c(0,1)) +
theme_tufte(base_size = 15, base_family = "Roboto") +
theme(axis.text = element_text(color = "black"),
panel.border = element_rect(colour = "black", fill=NA, size=1),
legend.text = element_text(size = 12, family = "Roboto"),
legend.title = element_blank(),
legend.position = "none")
ggMarginal(plot_center,
type = "histogram",
col = "black",
fill = "orange",
margins = "both")
Data: Data
Code:
palette = brewer.pal(11,"RdYlGn") # ColorBrewewr.org spectral palette, 11 colors
ggmap_byscen = ggplot(wmap_byscen.df[wmap_byscen.df$variable !=c("AVG") &
wmap_byscen.df$ID_1 !=c("0"),], aes(x=long, y=lat, group=group))
ggmap_byscen = ggmap_byscen + geom_polygon(aes(fill=value)) + facet_wrap(~ variable)
ggmap_byscen = ggmap_byscen + geom_path(colour="grey50", size=.1)
ggmap_byscen = ggmap_byscen + geom_text(aes(x=c.long, y=c.lat, label=ID_1),size=5)
ggmap_byscen = ggmap_byscen + scale_fill_gradientn(name="% Change",colours=palette)
ggmap_byscen = ggmap_byscen + coord_fixed(xlim = longlimits, ylim = latlimits)
ggmap_byscen = ggmap_byscen + scale_y_continuous(breaks=seq(-60,90,30), labels=c("60ºS","30ºS","0º","30ºN","60ºN","90ºN"))
ggmap_byscen = ggmap_byscen + scale_x_continuous(breaks=seq(-180,180,45), labels=c("180ºW","135ºW","90ºW","45ºW","0º","45ºE","90ºE","135ºE","180ºE"))
ggmap_byscen = ggmap_byscen + labs(x="",y="",title="Average yield impacts across all crops across\nby climate scenarios (% change)")
ggmap_byscen = ggmap_byscen + theme(plot.title=element_text(size=rel(2), hjust=0.5, vjust=1.5, face="bold"),
legend.text=element_text(size=17),
legend.position="left",legend.text=element_text(size=rel(1.3)),
legend.title=element_text(size=rel(1.4), hjust=0.5, vjust=1),
panel.background = element_rect(fill = "white", colour = "gray95"),
strip.text = element_text(size=18),
axis.text.x = element_text(size=16),
axis.text.y = element_text(size=16))
ggmap_byscen
Result:
Question: I am looking to add an additional legend defined by the column "label" in the dataframe to identify the region on the map. Preferably, I'd like the legend to be below the faceted map. I have seen examples where one can add a table entry as a separate plot and then merge the two. I could not figure out how to make it for my case.
Any help would be great, thanks.
As #jlhoward mentioned, longlimits and latlimits are not defined. I, therefore, decided to leave coord_fixed(xlim = longlimits, ylim = latlimits) part from this answer. My workaround works, but I am sure there are better ways to work on this. The challenge was to create another legend in a way it can present the data well. If you use colour in geom_text, you can create another legend, but you end up seeing the alphabet, a in the grey boxes in the legend. So, I decided to use geom_point with alpha = 0 as well as colour in aes. In this way, you have a new legend with ID names, but you do not see any points on the maps. Then, I used annotate to assign the numbers on the maps. Thanks to #jlhoward, I created a small data frame which is necessary for annotate(). If you use the original data frame, R tries to write the texts 4000 times or so. In the theme part, I added legend.key = element_rect(fill = NA) in order to remove grey squares in the legend. I made the height and width of the figure pretty small so that I could post it here. So it does not look that great. But if you specify large numbers, the figure will look better.
library(dplyr)
library(ggplot2)
wmap_byscen.df <- read.csv("mydata.csv", header = T)
mydf <- wmap_byscen.df[wmap_byscen.df$variable != c("AVG") &
wmap_byscen.df$ID_1 != c("0"),]
### This is for annotate()
mydf2 <- select(mydf, c.long, c.lat, ID_1, ID_name) %>%
distinct()
### Color setting
palette = brewer.pal(11,"RdYlGn")
ggplot(mydf, aes(x = long, y = lat, group = group)) +
geom_polygon(aes(fill = value)) +
facet_wrap(~ variable) +
geom_path(colour = "grey50", size = .1) +
geom_point(aes(x = c.long, y = c.lat, color=factor(ID_name, levels=unique(ID_name)), label = ID_1), size = 1, alpha = 0) +
annotate("text", x = mydf2$c.long, y = mydf2$c.lat, label = mydf2$ID_1) +
scale_fill_gradientn(name = "% Change",colours = palette) +
scale_color_discrete(name = "Regions") +
#coord_fixed(xlim = longlimits, ylim = latlimits) +
scale_y_continuous(breaks = seq(-60,90,30), labels = c("60ºS","30ºS","0º","30ºN","60ºN","90ºN")) +
scale_x_continuous(breaks = seq(-180,180,45), labels = c("180ºW","135ºW","90ºW","45ºW","0º","45ºE","90ºE","135ºE","180ºE")) +
labs(x = "",y = "",title = "Average yield impacts across all crops across\nby climate scenarios (% change)") +
theme(plot.title = element_text(size = rel(2), hjust = 0.5, vjust = 1.5, face = "bold"),
legend.text = element_text(size = 8),
legend.position = "bottom",
legend.text = element_text(size = rel(1.3)),
legend.title = element_text(size = rel(1.4), hjust = 0.5, vjust = 1),
panel.background = element_rect(fill = "white", colour = "gray95"),
strip.text = element_text(size = 18),
axis.text.x = element_text(size = 16),
axis.text.y = element_text(size = 16),
legend.key = element_rect(fill = NA)) +
guides(col = guide_legend(nrow = 3, byrow = TRUE))