This is my code I currently have to compare responses by year, but I want to be able to add the variable of race to be displayed in the data. Such as stacked data with a legend with different colors to represent race.
data1820$Q8_4 = car::recode(data1820$Q8_4, "1='Yes'; 2 = 'No'; 3 = 'NR'")
data1820$Q8_4 <-
factor(data1820$Q8_4, levels = c("Yes", "No", "NR"))
#Do you currently have any kind of health coverage
df <-
data1820 %>% group_by(year) %>% count(Q8_4) %>% na.omit() %>%
mutate(Percent = n / sum(n) * 100)
g <- ggplot(df, aes(x = Q8_4, y = Percent, fill = year)) +
geom_bar(stat = 'identity') +
facet_grid(cols = vars(year)) +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
strip.background = element_blank(),
panel.spacing = unit(4, "lines"),
text = element_text(family = "Helvetica",
size = 10),
axis.ticks.x = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
plot.title = element_text(hjust = 0.5, vjust = 2),
legend.title = element_blank(),
legend.position = "none",
plot.margin = margin(10, 10, 10, 10)
) +
labs(title = "Do you currently have any kind of health coverage",
y = "Percentage",
fill = "year") +
scale_fill_manual(values = colors, na.value = "grey") +
scale_y_continuous(labels = scales::percent_format(scale = 1)) +
scale_linetype_manual(guide = guide_legend(reverse = TRUE))
Related
suppose I have this dataset
data3 <- data.frame(
id = c(1:10),
marker = paste("Marker", seq(1, 10, 1)),
value = paste(rep(c(0,1), times = 2, length.out = 10))
) %>%
mutate(id = row_number(), angle = 90 - 360 * (id - 0.5) / n())
I want to make a chart like this:
[
Image taken from Royam et al, 2019
I have tried using coord_polar() with codes as follow:
ggplot(data = data3, aes(x = factor(id), y = 2, fill = factor(value), label = marker)) +
geom_bar(stat = 'identity', position = 'dodge') +
geom_text(hjust = 1.5, angle = data3$angle) +
coord_polar() +
scale_fill_manual(values = alpha(c('green', 'red'), 0.3), breaks = c(0, 1), labels = c('Upregulated', 'Downregulated')) +
guides(fill = 'none') +
theme(
axis.text.y = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.title.x = element_blank(),
axis.ticks = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.border = element_blank(),
panel.background = element_blank()
)
Which returns this figure:
How can I make the labels kept upright? Additionally, am I going to the right direction in creating the sample plot? Is there any other command in ggplot2 which may create such a figure?
Thank you very much in advance
pet_bar <- ggplot(pet_adopt, aes(x=Size, group = Status)) +
geom_bar(width= 0.65, aes(fill= Status)) +
geom_text(stat="count", position = position_stack(vjust= 0.5), aes(fill=Size,label = ..count..)) +
theme(legend.position = c(0.93, 0.88), axis.title = element_blank(), panel.background = element_blank(), axis.line.x = element_line(colour = "gray"), axis.ticks = element_blank(), panel.grid.minor.y = element_blank()) +
facet_grid(~gender) +
scale_fill_manual(values = c("gray60", "gray90")) +
ggtitle("Adoption Status of Dogs during the Summer of 2020")
pet_bar
Some fake data, so I can reproduce your plotting code:
fake_pet_adopt = crossing(gender = c("Female", "Male"),
Status = c("Adopted", "Not Adopted"),
Size = c("Large", "Medium", "Small")) %>%
mutate(number = 32:21) %>%
uncount(number)
Edit: I misread the original question before, and have updated here to have the text over the bars represent "% adopted" not total #. There are a few calculations, so I find it simpler to do those before ggplot using dplyr functions:
fake_pet_adopt_counts <- fake_pet_adopt %>%
count(gender, Size, Status)
adopt_shares <- fake_pet_adopt_counts %>%
group_by(gender, Size) %>%
mutate(total = sum(n),
share = n / sum(n)) %>%
filter(Status == "Adopted")
Then we can feed those in, where one text layer uses the adopt_shares table to get the % labels and locations:
ggplot(fake_pet_adopt_counts,
aes(x=Size, y = n, label = n, group = Status)) +
geom_col(width= 0.65, aes(fill= Status)) +
geom_text(position = position_stack(vjust= 0.5)) +
geom_text(data = adopt_shares, vjust = -0.2,
aes(y = total, label = scales::percent(share, accuracy = 0.1))) +
theme(legend.position = c(0.93, 0.88), axis.title = element_blank(), panel.background = element_blank(), axis.line.x = element_line(colour = "gray"), axis.ticks = element_blank(), panel.grid.minor.y = element_blank()) +
facet_grid(~gender) +
scale_fill_manual(values = c("gray60", "gray90")) +
ggtitle("Adoption Status of Dogs during the Summer of 2020")
How can I implement histogram with such complex x-axis?
First x-axis row is the week start, second - week end.
Data for tests in csv: https://gofile.io/d/FrhLZh.
What I managed to
hist_data %>%
ggplot(aes(x = week, y = count)) +
geom_col(fill = "#5B879E", width = 0.9, size = 0.7) +
labs(title = "", x = "", y = "") +
theme_bw() + theme_minimal() + theme(legend.position="none")+
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(vjust = 0.5, size = 8, family = "Inter", colour = "#ffffff"),
axis.line.x = element_blank(),
axis.title.x = element_blank(),
plot.background = element_rect(fill = "#3A464F"),
plot.margin=unit(c(0,0.25,0.5,0), "cm"))+
scale_x_discrete(expand=c(0,0), labels = format(as.Date(hist_data$week_start), "%d-%m"), position = "bottom") +
scale_y_continuous()
Thanks to teunbrand and his ggh4x package, solution:
hist_data %>%
ggplot(aes(x = week, y = count)) +
geom_col(fill = "#5B879E", width = 0.8, size = 0.7)+
labs(title = "", x = "", y = "") +
theme_bw() + theme_minimal() + theme(legend.position="none")+
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(vjust = 0.5, size = 8, lineheight = 0.8, family = "Inter", colour = "#ffffff"),
axis.line.x = element_blank(),
axis.title.x = element_blank(),
ggh4x.axis.nestline.x = element_line(size = 0.5, colour = "#5B879E", lineend = "square"),
plot.background = element_rect(fill = "#3A464F"),
plot.margin=unit(c(1,0.5,1,0.5), "cm"))+
scale_x_discrete(expand=c(0,0),
labels = paste0(format(as.Date(sort(hist_data$week_start)), "%d.%m"),
"\n", "nonsense", "\n",
format(as.Date(sort(hist_data$week_end)), "%d.%m")), position = "bottom") +
scale_y_continuous() +
guides(x = guide_axis_nested(delim = "nonsense"))
You can add multiple layers of geom_text and geom_segment. Adjust the relative y positions of these layers using a scaling factor.
plotscale <- max(hist_data$count)/50
library(ggplot2)
ggplot(data = hist_data,
aes(x = week_start + floor(week_end-week_start)/2, y = count)) +
geom_col(fill = "#5B879E", width = 4) +
geom_text(aes(y = -6 * plotscale ,
label = format(week_start, "%m-%d")),
color = "#ffffff")+
geom_segment(aes(x = week_start, xend = week_end,
y = -10 * plotscale, yend = -10 * plotscale),
color = "#5B879E", size = 1.5)+
geom_text(aes(y = -14 * plotscale,
label = format(week_end, "%m-%d")),
color = "#ffffff")+
theme_minimal() +
theme(
panel.grid = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
plot.background = element_rect(fill = "#3A464F"))+
scale_x_date(expand=c(0,0), date_breaks = "1 week",
labels = NULL)
Consider using ggh4x package for more complex nested x axes.
Raw Data
hist_data <- read.table(text='"","week","count","week_start","week_end"
"1","1",21.5823972708382,2021-01-04,2021-01-10
"2","2",36.122556304552,2021-01-11,2021-01-17
"3","3",34.2809483156697,2021-01-18,2021-01-24
"4","4",25.8546925450454,2021-01-25,2021-01-31
"5","5",29.0309819292706,2021-02-01,2021-02-07
"6","6",33.1503608888827,2021-02-08,2021-02-14
"7","7",27.0490347440184,2021-02-15,2021-02-21
"8","8",30.3031289757874,2021-02-22,2021-02-28
"9","50",32.2876434072602,2020-12-07,2020-12-13
"10","51",33.1939593686481,2020-12-14,2020-12-20
"11","52",26.6853246329896,2020-12-21,2020-12-27
"12","53",23.0715199391151,2020-12-28,2021-01-03', header = TRUE, sep = ",")
hist_data$week_start <- as.Date(hist_data$week_start)
hist_data$week_end <- as.Date(hist_data$week_end)
I have plotted a donut chart with the code below:
library(tidyverse)
library(ggthemes)
df <- data.frame(flavor = c("Chocolate", "Strawberry", "Pistachio"),
per_sold = c(.20, .30, .50))
df %>%
ggplot(aes(x = 2, y = per_sold, fill = flavor)) +
geom_bar(stat = "identity") +
xlim(0.5, 2.5) +
coord_polar(start = 0, theta = "y") +
xlab("") +
ylab("") +
theme(axis.ticks = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
panel.border = element_blank(),
legend.title = element_text(size = rel(2)),
legend.text=element_text(size=rel(1.5))) +
geom_text(aes(label = per_sold), size = 6)
Out:
As you can see, the position of labels are not correct, also I want it show the format of % instead of float number with digit.
How could I modify the code to achive this? Thanks.
All you need is position_stack(vjust = 0.5) and scales::percent:
library(scales)
df %>%
ggplot(aes(x = 2, y = per_sold, fill = flavor)) +
geom_bar(stat = "identity") +
xlim(0.5, 2.5) +
coord_polar(start = 0, theta = "y") +
xlab("") +
ylab("") +
theme(axis.ticks = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
panel.border = element_blank(),
legend.title = element_text(size = rel(2)),
legend.text=element_text(size=rel(1.5))) +
geom_text(aes(label = scales::percent(per_sold)),
size = 6, position = position_stack(vjust = 0.5))
I have run the following code :`
g <- ggplot(results_table, aes(x = "", y = Pct*100, fill = Criteria),width = 1) +
geom_bar(stat = "identity", color = Palcolor, fill = Palcolor) +
coord_polar(theta = "y", start = 0) +
theme_minimal() +
theme(legend.position = "bottom", legend.title=element_blank(), axis.title.x = element_blank(),,
axis.title.y = element_blank(), panel.border = element_blank(), panel.grid = element_blank(),
axis.text = element_blank(), axis.ticks = element_blank(),
plot.title = element_text(size = 14, hjust = 0.5, vjust = 0)) +
guides(fill = guide_legend(nrow = 4, byrow = TRUE)) +
theme(
legend.key.height = unit(0.3, "lines"), #smaller squares
legend.key.width = unit(0.7, "lines"), #smaller squares
legend.margin=margin(l = 40, unit='pt'),
legend.text = element_text(margin = margin(r = 60, unit = "pt"))) +
xlab("") +
ylab("") +
geom_text(aes(x = 1.70, y = Pct*100/2 + c(0, cumsum(Pct*100)[-length(Pct*100)]),
label = paste0(sprintf("%0.1f", round(Pct*100, digits = 1)),"%")),
size = 3.2) +
labs(title = gTitle)
}`
It created the pie chart as expected, but not the customized legend :
Any idea ?
The problem is that you set the custom color and fill palettes as arguments inside geom_bar. This way no legend will show up. You have to use scale_color/fill_manual to set the color palettes for the color/fill aesthetics.
Using ggplot2::mpg as example data and an example palette from RColorBrewer try this:
library(ggplot2)
library(dplyr)
# Example data
results_table <- mpg %>%
count(class) %>%
mutate(Pct = n / sum(n),
class = reorder(class, Pct)) %>%
rename(Criteria = class) %>%
arrange(desc(Pct)) %>%
mutate()
# Example palette as named vector to get the colors and categories right
Palcolor <- c("2seater" = "#8DD3C7", "minivan" = "#FFFFB3", "pickup" = "#BEBADA", "subcompact" = "#FB8072", "midsize" = "#80B1D3", "compact" = "#FDB462", "suv" = "#B3DE69")
# Example title
gTitle = "Example title"
g <- ggplot(results_table, aes(x = "", y = Pct*100, fill = Criteria),width = 1) +
geom_bar(stat = "identity") +
scale_color_manual(values = Palcolor) +
scale_fill_manual(values = Palcolor) +
coord_polar(theta = "y", start = 0) +
theme_minimal() +
theme(legend.position = "bottom", legend.title=element_blank(), axis.title.x = element_blank(),,
axis.title.y = element_blank(), panel.border = element_blank(), panel.grid = element_blank(),
axis.text = element_blank(), axis.ticks = element_blank(),
plot.title = element_text(size = 14, hjust = 0.5, vjust = 0)) +
guides(fill = guide_legend(nrow = 4, byrow = TRUE)) +
theme(
legend.key.height = unit(0.3, "lines"), #smaller squares
legend.key.width = unit(0.7, "lines"), #smaller squares
legend.margin=margin(l = 40, unit='pt'),
legend.text = element_text(margin = margin(r = 60, unit = "pt"))) +
xlab("") +
ylab("") +
geom_text(aes(x = 1.70, y = Pct*100/2 + c(0, cumsum(Pct*100)[-length(Pct*100)]),
label = paste0(sprintf("%0.1f", round(Pct*100, digits = 1)),"%")),
size = 3.2) +
labs(title = gTitle)
g
Created on 2020-05-16 by the reprex package (v0.3.0)