Related
you'll see with the code below that I end up with a nicely faceted plot that looks how I need it, but all I want is to hide the y axis labels for all facets except the ones on the far left. So hide labels for facet 2, 3, 4, 6, and 7. That way I am just left with "White", "Black", and "Hispanic" on the far left of each row (I can clean up the prefix_ later). Any ideas?
d2 %>%
ggplot(., aes(x = var_new, y = coef,
ymin = ci_lower, ymax = ci_upper)) +
geom_point(color = "red") +
geom_errorbar(width = 0,
size = 1,
color = "red") +
facet_wrap(~model,
nrow = 2,
scales = "free") +
geom_hline(yintercept = 0, linetype = "dashed", color = "black", size = .3) +
coord_flip() +
theme_minimal(base_size = 10) +
theme(legend.position = "none")
structure(list(model = c(7, 6, 5, 7, 6, 5, 7, 6, 5, 4, 3, 4,
3, 4, 3, 2, 1, 2, 1, 2, 1), race = c("hispanic", "hispanic",
"hispanic", "black", "black", "black", "white", "white", "white",
"hispanic", "hispanic", "black", "black", "white", "white", "hispanic",
"hispanic", "black", "black", "white", "white"), var_new = c("ela_hispanic",
"math_hispanic", "sci_hispanic", "ela_black", "math_black", "sci_black",
"ela_white", "math_white", "sci_white", "after_hispanic", "before_hispanic",
"after_black", "before_black", "after_white", "before_white",
"part_hispanic", "full_hispanic", "part_black", "full_black",
"part_white", "full_white"), coef = c(0.91, 0.2615005, -0.0622102,
3.1966945, 0.9665615, 0.4419779, -4.1608082, -1.75, -3.4185874,
-1.72661788, -1.87514649, 0.61605887, 0.58634364, 0.87, 0.4,
1.52820746, 1.35976557, 1.08885352, 0.8323809019, 0.728991331,
1.53140561), ci_lower = c(0.3, -1.04316665, -1.68479242, -1.0382233,
-0.70264707, -1.29579134, -12.008101, -3, -6.4522842, -1.9858909,
-2.10047863, 0.41173674, 0.37007869, -0.3428254, -0.1, 1.21339829,
1.07813362, 0.778488586, 0.44183285, 0.30081336, 0.98770764),
ci_upper = c(1.2, 1.748, 1.560372, 7.4316126, 2.63577, 2.179747,
3.6864845, 0.01, -0.3848905, -1.467344828, -1.64981433, 0.8203809961,
0.802608596, 0.4, 0.8, 1.8430166, 1.64139752, 1.39921842,
1.22292898, 1.15716932, 2.0751036)), row.names = c(NA, -21L
), class = c("tbl_df", "tbl", "data.frame"))
I don't understand why folks continue to switch the x and y axis variables then use coord_flip to put them round the right way. This is confusing, unnecessary, and requires more code. It's best to just put the variables round the right way and keep the coord as-is.
Once that's done, the simplest solution is to put race on the y axis, and change scales to free_x. I've added a border around each panel to make things a bit clearer.
library(tidyverse)
ggplot(d2, aes(y = race, x = coef, xmin = ci_lower, xmax = ci_upper)) +
geom_errorbar(width = 0, linewidth = 1.5, color = "red3", alpha = 0.5) +
geom_point(shape = 21, fill = "red2", size = 3, color = 'white') +
facet_wrap(~ model, nrow = 2, scales = 'free_x') +
geom_vline(xintercept = 0, linetype = "dashed", linewidth = 0.3) +
theme_minimal(base_size = 14) +
theme(legend.position = "none",
panel.grid.major.y = element_blank(),
panel.border = element_rect(color = 'gray75', fill = NA))
If you want to include the prefixes in the facet titles (since they have a 1:1 correspondence with model), you could use tidyr::separate:
d2 %>%
separate(var_new, into = c('model_name', 'race')) %>%
mutate(model = paste(model, model_name, sep = ' - ')) %>%
ggplot(aes(y = race, x = coef, xmin = ci_lower, xmax = ci_upper)) +
geom_errorbar(width = 0, linewidth = 1.5, color = "red3", alpha = 0.5) +
geom_point(shape = 21, fill = "red2", size = 3, color = 'white') +
facet_wrap(~model, nrow = 2, scales = 'free_x') +
geom_vline(xintercept = 0, linetype = "dashed", linewidth = 0.3) +
theme_minimal(base_size = 14) +
theme(legend.position = "none",
panel.grid.major.y = element_blank(),
panel.border = element_rect(color = 'gray75', fill = NA))
Addendum
To compare coefficients across groups like this, it is normally better to put them all in a single linerange plot (similar to a forest plot). I think this provides a much better visualization that requires less cognitive effort from the reader. This also shows a good use-case for coord_flip, namely when you want a vertical dodge between groups.
d2 %>%
separate(var_new, into = c('model_name', 'race')) %>%
mutate(model = paste0('Model ', model, ' : ', model_name)) %>%
ggplot(aes(x = model, y = coef, ymin = ci_lower, ymax = ci_upper,
color = race)) +
annotate("segment", y = rep(-Inf, 3), yend = rep(Inf, 3),
x = c('Model 2 : part', 'Model 4 : after', 'Model 6 : math'),
xend = c('Model 2 : part', 'Model 4 : after', 'Model 6 : math'),
linewidth = 22, alpha = 0.05) +
coord_flip() +
geom_errorbar(width = 0, linewidth = 1, alpha = 0.5,
position = position_dodge(width = 0.5)) +
geom_point(size = 1.5, position = position_dodge(width = 0.5)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "black",
linewidth = 0.3) +
scale_color_brewer(palette = 'Set1') +
theme_minimal(base_size = 14) +
guides(color = guide_legend(reverse = TRUE)) +
theme(panel.grid.major.y = element_blank(),
panel.border = element_rect(color = 'gray75', fill = NA),
axis.text.y = element_text(hjust = 0))
I try to replicate the fertility graph from gapminder as good as I can in ggplot:
I have:
fertility <- read.csv("https://raw.githubusercontent.com/MarcoKuehne/marcokuehne.github.io/main/data/Gapminder/tfr-by-gapminder-v12-20171212.csv", sep = ";")
# manipulate
library(tidyverse)
fertility <- fertility %>%
select(!c(geo.name, geo, indicator)) %>%
rownames_to_column %>%
gather(var, value, -rowname) %>%
spread(rowname, value) %>%
rename(year = var, fert = `1`) %>%
slice_head(n = 301)
fertility[,1:2] <- sapply(fertility[,1:2],FUN=as.numeric)
fertility1 <- fertility[1:217,]
fertility2 <- fertility[218:301,]
# visualize
ggplot(data = fertility, aes(x=year, y=fert)) +
geom_point(aes(x=year[1], y=fert[1]), size = 4) +
geom_text(aes(x=year[1], y=fert[1], label = year[1]), vjust = 2.5) +
geom_point(aes(x=year[165], y=fert[165]), size = 4) +
geom_text(aes(x=year[165], y=fert[165], label = year[165]), vjust = -3, hjust = -0.5) +
geom_text(aes(x=year[165], y=fert[165], label = "5 births"), vjust = -1.5, hjust = -0.2) +
#geom_point(aes(x=year[217], y=fert[217]), size = 4) +
geom_text(aes(x=year[217], y=fert[217], label = year[217]), vjust = -3) +
geom_text(aes(x=year[217], y=fert[217], label = "2.5 births"), vjust = -1.5) +
geom_line(data = fertility1, size=1.3, arrow=arrow(length=unit(0.30,"cm"), ends="last", type = "closed")) +
geom_line(data = fertility2, size=1.3,linetype="dashed") +
labs(title = "Average Number Of Babies Per Woman From 1800 to Today",
caption = "Source: Gapminder based on UN-Pop", y="", x="") +
theme_minimal() +
theme(panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())
I have some troubles with the linewidth of geom_line(). And I am looking for a compromise between geom_line() and geom_smooth() to make the line plot just a little bit more smooth.
But my major concern at the moment is the broken y-axis. When y-axis does not start at zero, I'd like to hightlight this as in the gapminder graph.
Following the suggestion by #Roland you could smooth your lines using a loess curve. However, instead of trying with geom_smooth I would suggest to do the calculation outside of ggplot as we need the smoothed values also for the points and the labels and we also need the same values for "both" lines.
For your axis break a simple approach would be to use two annotate, one to place the segments, one to add the filled "gap" for which I use a ribbon. This requires some fiddling to get the right positions, to fix the limits and to set clip="off". Also note that I added the axis lines via geom_h/vline so that the annotate layers could be placed on top of the axes.
Finally, I slightly adjusted your data wrangling code, use a dataset to place the labels and points and instead of using vjust I shift the labels directly via the y position.
EDIT For the final touch I added some additional styling.
# manipulate
library(tidyverse)
library(showtext)
library(hrbrthemes)
font_add_google("lato", "Lato", regular.wt = 900)
fertility <- fertility %>%
select(!c(geo.name, geo, indicator)) %>%
mutate(
across(-indicator.name, as.character),
across(-indicator.name, ~ readr::parse_number(.x, locale = locale(decimal_mark = ",")))
) %>%
pivot_longer(-indicator.name, names_to = "year", values_to = "fert", names_prefix = "X") %>%
mutate(year = as.numeric(year)) |>
mutate(fert_smooth = predict(loess(fert ~ year, span = .05)))
fertility_to_high <- fertility |>
filter(year %in% c(1800, 1964, 2016)) |>
mutate(
label = if_else(!year == 1800, paste0(year, "<br>**", round(fert, 1), " births**"), as.character(year)),
hjust = if_else(year == 2016, 0, .5)
)
ggplot(data = fertility, aes(x = year, y = fert_smooth)) +
geom_point(data = subset(fertility_to_high, year == 1964), size = 10, shape = 21, fill = NA, color = "black") +
geom_point(data = subset(fertility_to_high, year != 2016), size = 3) +
ggtext::geom_richtext(data = fertility_to_high, aes(y = fert + .15, label = label, hjust = hjust),
vjust = 0, label.colour = NA, family = font_rc, lineheight = 1.2) +
geom_line(linewidth = 1.3, linetype = "dashed") +
geom_line(data = ~ subset(.x, year <= 2016), linewidth = 1.3, arrow = arrow(length = unit(0.30, "cm"), ends = "last", type = "closed")) +
geom_hline(yintercept = 1) +
geom_vline(xintercept = 1785) +
annotate(geom = "ribbon", x = c(1780, 1790) - .55, ymin = c(1.3, 1.5), ymax = c(1.5, 1.7), fill = "white") +
annotate(
geom = "segment",
x = c(1780, 1780) - .5, xend = c(1790, 1790) - .5,
y = c(1.3, 1.5), yend = c(1.5, 1.7), linewidth = 1
) +
scale_y_continuous(breaks = 1:6, labels = c(0, 2:6), expand = c(0, .0, .05, 0)) +
scale_x_continuous(expand = c(0.05, 0, 0, 0)) +
labs(
title = toupper("Average Number Of Babies Per Woman From 1800 to Today"),
caption = "Source: Gapminder based on UN-Pop", y = "", x = ""
) +
coord_cartesian(clip = "off", ylim = c(1, 6), xlim = c(1800, NA)) +
theme_bw(base_family = font_rc, base_size = 12) +
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
plot.title = element_text(family = "lato"),
plot.title.position = "plot",
plot.caption = element_text(family = "lato", color = "grey40"),
axis.text.x = element_text(hjust = c(rep(.5, 3), 1))
)
The key is to add:
scale_y_continuous(limits = c(0, 6.2), expand = c(0, 0))
It tells R to limit the y range within 0 and 6.2, and show no gap beyond these two values.
The sample code below may work for you, after running it, you will get:
fertility <- read.csv("https://raw.githubusercontent.com/MarcoKuehne/marcokuehne.github.io/main/data/Gapminder/tfr-by-gapminder-v12-20171212.csv", sep = ";")
# manipulate
library(tidyverse)
fertility <- fertility |>
select(!c(geo.name, geo, indicator)) |>
t() |>
as.data.frame() |>
rownames_to_column() |>
slice(-1) |>
as_tibble() |>
rename(c(year = rowname, fert = V1)) |>
mutate(year = str_remove(year, "X"),
year = as.Date(ISOdate(year, 1, 1)),
fert = str_replace(fert, ",", "."),
fert = as.numeric(fert),
fert_1 = case_when(year <= as.Date("2017-01-01") ~ fert,
TRUE ~ as.numeric(NA)),
fert_2 = case_when(year >= as.Date("2017-01-01") ~ fert,
TRUE ~ as.numeric(NA)),
arr_data = case_when((year > as.Date("2014-01-01") & year < "2018-01-01") ~ fert,
TRUE ~ as.numeric(NA)))
fertility |>
ggplot(aes(x = year,
y = fert)) +
geom_smooth(aes(x = year,
y = fert_1,
group = 1),
span = 0.11,
se = FALSE,
colour = "black",
size = 1.5) +
geom_line(aes(x = year,
y = arr_data),
arrow = arrow(length=unit(0.4,"cm"),
ends="last",
type = "closed"),
size = 3) +
geom_line(aes(x = year,
y = fert_2,
group = 1),
linetype = 2,
size = 1.5) +
geom_point(aes(x = year[1],
y = fert[1]),
size = 5) +
annotate(geom = "text",
x = fertility$year[1],
y = fertility$fert[1],
label = "1800",
size = 4,
vjust = -1.2) +
geom_point(aes(x = fertility$year[166],
y = fertility$fert[166]),
shape = 1,
size = 12,
colour = "grey50") +
annotate(geom = "text",
x = fertility$year[166],
y = fertility$fert[166],
label = "1965",
size = 4,
vjust = -4.2) +
annotate(geom = "text",
x = fertility$year[166],
y = fertility$fert[166],
label = "5 births",
size = 5,
fontface = "bold",
vjust = -2) +
geom_point(aes(x = fertility$year[166],
y = fertility$fert[166]),
shape = 1,
size = 12,
colour = "grey50") +
annotate(geom = "text",
x = fertility$year[166],
y = fertility$fert[166],
label = "1965",
size = 4,
vjust = -4.2) +
annotate(geom = "text",
x = fertility$year[166],
y = fertility$fert[166],
label = "5 births",
size = 5,
fontface = "bold",
vjust = -2) +
annotate(geom = "text",
x = fertility$year[218],
y = fertility$fert[218],
label = "2017",
size = 4,
vjust = -4.2,
hjust = 0) +
annotate(geom = "text",
x = fertility$year[218],
y = fertility$fert[218],
label = "2.5 births",
size = 5,
fontface = "bold",
vjust = -2,
hjust = 0) +
theme_bw() +
scale_x_date(expand = expansion(mult = c(0.02, 0))) +
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.border = element_blank(),
axis.text.x = element_text(size = 10),
axis.line.x = element_line(),
axis.line.y = element_line(),
plot.caption = element_text(colour = "grey50"),
plot.title = element_text(size = 16,
hjust = 0.5,
face = "bold"),
plot.margin = margin(r = 18,
t = 5,
l = 5,
b = 2)
) +
labs(
title = "AVERAGE NUMBER OF BABIES PER WOMAN FROM 1800 TO TODAY",
x = element_blank(),
y = element_blank(),
caption = "Source:Gapminder[7] based on UN-Pop[3]"
)
Let
df <- data.frame("Method" = rep(c("Method1", "Method2", "Method3", "Method4", "Method5"), each = 3, times = 1),
"Type" = rep(c("A", "B", "C"), 5),
"Value" = c(runif(5, 0, 1), runif(5, 0.2, 1.2), runif(5, 0.4, 1.4)))
I created a boxplot
get_box_stats <- function(y, upper_limit = max(df$Value) * 1.42) {
return(data.frame(
y = upper_limit,
label = paste(
length(y), "\n",
round(quantile(y, 0.25), 2), "\n",
round(median(y), 2), "\n",
round(quantile(y, 0.75), 2), "\n"
)
))
}
ggplot(df, aes(factor(Type), Value)) +
labs(fill = "Method") +
stat_summary(size = 4.6, fun.data = get_box_stats, geom = "text", position = position_dodge(.9),
hjust = 0.5, vjust = 1, aes(group = factor(Type)))+
geom_boxplot(coef = 0, aes(fill = factor(Type))) + theme_classic()+
theme(legend.position = "top", axis.text.x = element_text(size = 15),
axis.text.y = element_text(size = 15),
axis.title.x = element_text(size = 15),
axis.title.y = element_text(size = 15),
legend.title=element_text(size = 15),
legend.text=element_text(size = 15)) +
geom_dotplot(aes(fill = factor(Type)), dotsize = 0.8, binaxis = 'y', stackdir = 'center',
position = position_dodge(0.75))+
xlab("Method")
This results in a boxplot
QUESTION: As you can see, for stats are not perfectly centered, i.e for Method B -- values 1 and 5. Is there a way to fix this?
The problem lies in your use of paste in your summary function. By default, paste adds a space character between each element you want to paste together. Your summary string therefore has a space before and after every line break, but not before the first line. Since a space takes up some room, the aligment is off. Instead of adding in all those newline characters, specify that you want to use just a newline character as a separator using the sep argument:
get_box_stats <- function(y, upper_limit = max(df$Value) * 1.42) {
return(data.frame(
y = upper_limit,
label = paste(
length(y),
round(quantile(y, 0.25), 2),
round(median(y), 2),
round(quantile(y, 0.75), 2), sep = "\n"
)
))
}
ggplot(df, aes(factor(Type), Value)) +
labs(fill = "Method") +
stat_summary(size = 4.6, fun.data = get_box_stats, geom = "text",
hjust = 0.5, vjust = 1, aes(group = factor(Type)))+
geom_boxplot(coef = 0, aes(fill = factor(Type))) + theme_classic()+
theme(legend.position = "top", axis.text.x = element_text(size = 15),
axis.text.y = element_text(size = 15),
axis.title.x = element_text(size = 15),
axis.title.y = element_text(size = 15),
legend.title=element_text(size = 15),
legend.text=element_text(size = 15)) +
geom_dotplot(aes(fill = factor(Type)), dotsize = 0.8, binaxis = 'y',
stackdir = 'center',
position = position_dodge(0.75))+
xlab("Method")
I have a set of points in a scatter plot as below. I want to change the shape of one point or few points. I searched for this but could not find a way to do it.
I want to achieve like this
And like this
Code:
df <- data.frame(x = c(1,2,2,3,3.5,4,4.5,5,5.5,6,1.5,2,2,2,2,1.5,2.5,3,3,3,3,5.5,5,6,5.5,7)
,y = c(2,1,2,2,2,2,2,2,1.5,2,2.5,3,3.5,4,4.5,3.5,3.5,2,3,3.5,4,2.5,3,3,4,3.5))
library(ggplot2)
library(extrafont)
# helper dataframe for axis
df_arrow <- data.frame(x = c(0, 0),
y = c(0, 0),
xend = c(0, 8),
yend = c(8, 0))
ggplot(df,aes(x, y)) +
geom_point(colour = "blue", size = 5, shape = 3)+
scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6, family = "Times New Roman")+
labs(x = NULL,
y = NULL)+
theme_bw()+
theme(panel.grid.major = element_line(colour = "gray80"),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
axis.ticks.length = unit(1, "mm"),
text = element_text(size = 18, family = "Times New Roman"))
How is this?
Create a new column using dplyr::mutate, which is conditional upon the x-coordinates (for example, but it could be anything). Then, use this column within aes to control the shape size.
Also, you can use scale_shape_manual and scale_colour_manual to manually control the shape and colours. It's not clear to me what shape you want but you would just need to change the arguments in scale_shape_manual.
EDIT:
Since you specifically need a different symbol, then you need to use geom_text instead.
df %>%
dplyr::mutate(z = ifelse(x >= 5, "-", "+")) %>%
ggplot(aes(x, y)) +
geom_text(size = 12, aes(colour=z, label=z)) +
scale_x_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
scale_y_continuous(breaks = 1:7, expand = expansion(add = c(0, 1)))+
coord_fixed(xlim = c(0, 7), ylim = c(0, 7), clip = "off")+
geom_segment(data = df_arrow, aes(x = x, xend = xend, y = y, yend = yend), size = 0.75, colour = "black",
arrow = arrow(angle = 20, length = unit(3, "mm"), ends = "last", type = "closed"), linejoin = "mitre") +
annotate("text", x = c(7.8, 0.3), y = c(0.3, 7.8), label = c("italic(x)", "italic(y)"), parse = TRUE, size = 6, family = "Times New Roman")+
labs(x = NULL,
y = NULL)+
theme_bw()+
theme(panel.grid.major = element_line(colour = "gray80"),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
axis.ticks.length = unit(1, "mm"),
text = element_text(size = 18, family = "Times New Roman")) +
scale_shape_manual(values=c(8, 9)) +
scale_colour_manual(values = c('red', 'blue'))
I have my code with that created two different graphs. I want to combine the graphs into one graph with "Elevation on the primary y axis and "Precipitation" on the secondary y axis. Is this possible or would it be best to stick with having the two graphs on top of each other?
pe1.plot <- combine.df %>% filter(site== "VWP 1") %>%
ggplot(aes(x = datetime, y = elevation)) +
geom_line(color = "blue")+
theme(plot.subtitle = element_text(vjust = 1),
plot.caption = element_text(vjust = 1),
plot.background = element_rect(linetype = "solid")) +labs(title = "VWP 1", x = "Date", y = "Elevation (MSL)")
precip.plot <- ggplot(precip.df, aes(x = datetime, y = precipitation)) +
geom_bar(stat = "identity")+
theme(plot.subtitle = element_text(vjust = 1),
plot.caption = element_text(vjust = 1),
plot.background = element_rect(linetype = "solid")) +labs(x = "Date", y = "Pecipitation (in.)")
pe1.plot+precip.plot + plot_layout(ncol = 1)
Possible but kind of a pain:
library(tidyverse)
set.seed(42)
my_data = tibble(date = seq.Date(as.Date("2020-01-01"),
as.Date("2020-06-30"), by = "day"),
line_y = seq(698, 700, length.out = 182) + rnorm(182, sd = 0.1),
bar_y = rpois(182, c(0,0,5))/10)
ggplot(my_data, aes(date)) +
geom_line(aes(y = line_y)) +
geom_col(aes(y = (2*bar_y) + 695)) +
scale_y_continuous(breaks = seq(695, 699.5, by = 0.5),
labels = c(rep("", 6), seq(698, 699.5, by = 0.5)),
sec.axis = sec_axis(~ (. - 695) / 2,
breaks = seq(0, 1, by = 0.25))) +
coord_cartesian(ylim = c(695, NA), expand = 0)