Related
I am trying to recreate this image in R, however I am unable to work out how to have 3 layers to a donut chart - everything I find (for instance, webr::PieDonut) only allows 2. Using ggplot I am also unable to re-create it.
A MRE is:
library(ggplot2)
library(webr)
library(dplyr)
lexicon <- data.frame("Level1" = c(rep("Flavour", 11), rep("Appearance", 4)),
"Level2" = c(rep("Misc", 6), rep("Pungent", 5), rep("Colour", 4)),
"Level3" = c("Fresh", "Refreshing", "Soapy", "Minty", "Nutty", "Milky", "Peppery", "Sharp", "Horseradish", "Mustard hot", "Spicy", "Colourful"," Fresh Green", "Dark Green", "Bright Green")
)
PieDonut(lexicon, aes(Level1, Level2), title = "Salad Lexicon", showRatioDonut =FALSE, showRatioPie = FALSE)
ggplot(lexicon, aes(Level2, Level3, fill = Level1)) +
geom_col() +
scale_fill_viridis_d() +
coord_polar("y")
While the PieDonut works for 2 levels (not shown), it doesn't allow the final level to be included. The ggplot approach also does not work, as seen in the figure below.
How can I get this style of chart in R? Either with ggplot or base plotting.
I think a nice alternative is to use geom_rect here after some data manipulation. Using the fill, color, and alpha scales can help improve the differentiation of categories. I would also use geom_textpath here, though I might go for circumferential labels if there is room to do so:
lexicon %>%
mutate(top_level = Level1) %>%
pivot_longer(1:3) %>%
group_by(name, value) %>%
mutate(width = n()) %>%
unique() %>%
arrange(name) %>%
group_by(name) %>%
mutate(ymid = as.numeric(sub("\\D+", "", name)),
ymax = ymid + 0.5, ymin = ymid - 0.5,
xmin = c(0, head(cumsum(width), -1)),
xmax = cumsum(width),
xmid = (xmax + xmin) / 2) %>%
ggplot(aes(xmid, ymid, fill = top_level)) +
geom_rect(aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax,
alpha = name, color = top_level)) +
geomtextpath::geom_textpath(aes(y = ymid + 0.25, label = value,
group = value)) +
scale_alpha_manual(values = c(1, 0.3, 0.1)) +
scale_fill_manual(values = c("#cd9900", "#00817e")) +
scale_colour_manual(values = c("#cd9900", "#00817e")) +
scale_y_continuous(limits = c(-0.5, 3.6)) +
coord_polar() +
theme_void() +
theme(legend.position = "none")
One option would be to reeshape your data to long and do some manual aggregating before passing to ggplot. Additionally I use geomtextpath::geom_textpath to add the labels:
library(ggplot2)
library(dplyr)
library(geomtextpath)
lexicon <- data.frame("Level1" = c(rep("Flavour", 11), rep("Appearance", 4)),
"Level2" = c(rep("Misc", 6), rep("Pungent", 5), rep("Colour", 4)),
"Level3" = c("Fresh", "Refreshing", "Soapy", "Minty", "Nutty", "Milky", "Peppery", "Sharp", "Horseradish", "Mustard hot", "Spicy", "Colourful"," Fresh Green", "Dark Green", "Bright Green")
)
lexicon_long <- lexicon |>
mutate(fill = Level1) |>
tidyr::pivot_longer(-fill, names_to = "level", values_to = "label") |>
mutate(label = forcats::fct_inorder(label)) |>
count(fill, level, label) |>
group_by(level) |>
mutate(pct = n / sum(n))
ggplot(lexicon_long, aes(level, pct, fill = fill)) +
geom_col(color = "white") +
geom_textpath(aes(label = label, group = label),
position = position_stack(vjust = .5),
upright = TRUE, hjust = .5, size = 3
) +
scale_fill_viridis_d() +
coord_polar("y") +
theme_void() +
guides(fill = "none")
Here's the code:
dummy <- data.frame(
Var1 = c("A", "B", "C", "D", "E"),
Freq = c(548, 326, 292, 199, 138)
)
dummy %>%
mutate(perc =scales::percent(Freq/sum(Freq))) %>%
arrange(desc(Var1)) %>%
mutate(pos = cumsum(Freq)- Freq/2) %>%
ggplot(aes(x = "", y = Freq, fill = factor(Var1) )) +
geom_bar(width = 1, stat = "identity") +
coord_polar("y", start = 0) +
ggrepel::geom_label_repel(aes(x = "", y = pos, label = perc), size=5, show.legend = F, nudge_x = 1) +
guides(fill = guide_legend(title = "Group"))
And here's the graph:
Is there a way to make it so that instead of having a legends tab, the names of each slice is placed within the slices in the pie graph itself?
It's pretty hard to understand what you want.
dummy %>%
mutate(perc =scales::percent(Freq/sum(Freq))) %>%
arrange(desc(Var1)) %>%
mutate(pos = cumsum(Freq)- Freq/2) %>%
ggplot(aes(x = "", y = Freq, fill = factor(Var1) )) +
geom_bar(width = 1, stat = "identity") +
coord_polar("y", start = 0) +
ggrepel::geom_label_repel(aes(x = "", y = pos, label = perc), size=5, show.legend = F, nudge_x = 1) +
guides(fill = guide_legend(title = "Group")) +
geom_text(aes(x=1.6, label=Var1),
position = position_stack(vjust=0.5))
I want text labels were above or under of bar cap depending on where is more space for them. Now it's always down which is not always looks good:
Here is my code:
library(tidyr)
library(ggplot2)
library(dplyr)
library(stringr)
library(purrr)
numa.nodes <- tibble (
numa_name = c("numa_01","numa_01","numa_01","numa_01","numa_01","numa_01","numa_02","numa_02","numa_02","numa_02"),
counter_name =c("cpu01","cpu02","cpu03","cpu04","memory_used","memory_total","cpu01","cpu02","memory_used","memory_total"),
value = c(sample(0:100,4), sample(0:32,1), 32, sample(0:100,1), sample(0:100,1), sample(0:128,1), 128)
)
numa.nodes <- numa.nodes %>% add_row(
numa_name = c("numa_03","numa_03","numa_03","numa_03","numa_03","numa_03","numa_04","numa_04","numa_04","numa_04"),
counter_name =c("cpu01","cpu02","cpu03","cpu04","memory_used","memory_total","cpu01","cpu02","memory_used","memory_total"),
value = c(sample(0:100,4), sample(0:32,1), 32, sample(0:100,1), sample(0:100,1), sample(0:128,1), 128)
)
numa.nodes <- numa.nodes %>% add_row(
numa_name = c("numa_05","numa_05","numa_05","numa_05","numa_05","numa_05","numa_05"),
counter_name =c("cpu01","cpu02","cpu03","cpu04","cpu05","memory_used","memory_total"),
value = c(sample(1:100,5), sample(1:64,1), 64)
)
numa.nodes <- numa.nodes %>% mutate(counter_name=factor(counter_name,levels = unique(counter_name),ordered = T))
memory_columns <- numa.nodes %>% filter(counter_name=='memory_total')
memory_y_scale <- max(memory_columns$value, na.rm = TRUE) + 6
plot_numa = function(num){
df = numa.nodes %>% filter(str_detect(numa_name, num))
cpu_plot = df %>%
filter(str_detect(counter_name, "cpu")) %>%
ggplot(aes(x = counter_name)) +
geom_col(aes(y = 100), fill = "white", color = "black") +
geom_col(aes(y = value), fill = "#00AFBB", color = "black") +
geom_text(aes(y = value, label = paste0(value,"%")), nudge_y = 5, color = "black") +
theme_bw() +
labs(x = "CPU", y = "")
memory_plot = df %>%
filter(str_detect(counter_name, "memory")) %>%
pivot_wider(names_from = counter_name, values_from = value) %>%
ggplot(aes(x = "") ) +
geom_col(aes(y = memory_total), fill = "white", color = "black") +
geom_col(aes(y = memory_used), fill = "#FC4E07", color = "black") +
geom_text(aes(label = paste(memory_total, "GB"), y = memory_total), nudge_y = 5, color = "black") +
geom_text(aes(label = paste(memory_used, "GB"), y = memory_used), nudge_y = -3, color = "black") +
theme_bw() +
ylim(0, memory_y_scale) +
labs(x = "Memory", y = "")
ggpubr::ggarrange(cpu_plot, memory_plot, ncol = 2) %>% ggpubr::annotate_figure(top = paste("NUMA",num))
}
numa_numbers <- unique(numa.nodes$numa_name) %>% str_remove ("numa_")
ggpubr::ggarrange(plotlist = map(.x = numa_numbers, .f = ~plot_numa(num = .x)))
I tried to change this line:
geom_text(aes(label = paste(memory_used, "GB"), y = memory_used), nudge_y = -3, color = "black")
to something like that:
geom_text(aes(label = paste(memory_used, "GB"), y = memory_used),nudge_y = ifelse( (memory_total-memory_used) > 10, 5, -3)
, color = "black")
But I've got an error:
Error in ifelse((memory_total - memory_used) > 10, 5, -3) :
object 'memory_total' not found
Is there a better way to print labels optimal way?
What am I doing wrong?
How to change color of label to more contrast ie black on white, white on red?
Think of it this way: The nudge value will be different (potentially) for every observation in your data frame. That means that this is something that should be handled within aes(), where stuff is designed to change with your data, rather than nudge_y, which is designed to be a constant (and complains if used otherwise).
So, the solution is to do away entirely with nudge_y and build your ifelse() statement directly into aes(y=...).
In this case, here's the replacement for that particular geom_text() line:
# to see the same plot posted here, put this at the top of your code
set.seed(7331)
...
# plot code...
... +
geom_text(aes(
label = paste(memory_used, "GB"),
y = ifelse((memory_total-memory_used > 10), memory_used + 5, memory_used - 3)),
color = "black") +
Not specific to any particular piece of code, is there a relatively straightforward way to change the color of the text in a geom_label_repel box?
Specifically, I have code that produces the below chart
The percentage in the label box is the percent change in 7-day moving average for the most recent week over the week prior. I'd simply like to color the text red when the value is positive and green when it is negative.
The dataframe for this chart can be copied from here.
The plot code is
#endpoint layer
BaseEndpoints <- smDailyBaseData %>% filter(Base %in% AFMCbases) %>%
group_by(Base) %>%
filter(DaysSince == max(DaysSince)) %>%
select(Base, abbv, DaysSince, newRate,label) %>%
ungroup()
ZoomEndpoints <- BaseEndpoints %>% filter(Base != 'Edwards') %>%
mutate(zoom = TRUE)
CAEndPoint <- BaseEndpoints %>% filter(Base == 'Edwards') %>%
mutate(zoom = FALSE)
ZoomEndpoints <- rbind(ZoomEndpoints, CAEndPoint)
BasePlot <- smDailyBaseData %>% filter(Base %in% AFMCbases) %>%
ggplot(mapping = aes(x = as.numeric(DaysSince), y = newRate)) +
geom_line(aes(color=abbv),show.legend = FALSE) +
scale_color_ucscgb() +
geom_point(data = BaseEndpoints,size = 1.5,shape = 21,
aes(color = abbv,fill = abbv), show.legend = FALSE) +
geom_label_repel(data=ZoomEndpoints, aes(label=label), show.legend = FALSE,
vjust = 0, xlim=c(105,200), size=3, direction='y') +
labs(x = "Days Since First Confirmed Case",
y = "% Local Population Infected Daily") +
theme(plot.title = element_text(size = rel(1), face = "bold"),
plot.subtitle = element_text(size = rel(0.7)),
plot.caption = element_text(size = rel(1))) +
facet_zoom(xlim = c(50,120), ylim=c(0,0.011),zoom.data=zoom)
print(BasePlot)
Yes, it's as simple as this:
library(ggplot2)
df <- data.frame(x = c(-1, -1, 1, 1), y = c(-1, 1, 1, -1), value = c(-2, -1, 1, 2))
ggplot(df, aes(x, y)) +
geom_point(size = 3) +
ggrepel::geom_label_repel(aes(label = value, colour = factor(sign(value)))) +
lims(x = c(-100, 100), y = c(-100, 100)) +
scale_colour_manual(values = c("red", "forestgreen"))
EDIT
Now we have a more concrete example, I can see the problem more clearly. There are workarounds such as using ggnewscale or a hand-crafted solution such as Ian Campbell's thorough example. Personally, I would just note that you haven't used the fill scale yet, and this looks pretty good to my eye:
Here's a bit of a hacky solution since you can't have two scale_color_*'s at the same time:
The approach centers on manually assigning the color outside of aes in the geom_label_repel call. Adding one to the grepl result that searches for the minus sign in the label allows you to subset the two colors. You need two colors for each label, I assume for the box and for the text, so I used rep.
smDailyBaseData %>%
ggplot(mapping = aes(x = as.numeric(DaysSince), y = newRate)) +
geom_line(aes(color=abbv),show.legend = FALSE) +
scale_color_ucscgb() +
geom_point(data = BaseEndpoints,size = 1.5,shape = 21,
aes(color = abbv,fill = abbv), show.legend = FALSE) +
geom_label_repel(data=ZoomEndpoints, aes(label=label),
color = rep(c("green","red")[1+grepl("\\-\\d",as.factor(ZoomEndpoints$label))],times = 2),
show.legend = FALSE, vjust = 0, xlim=c(105,200),
size=3, direction='y') +
labs(x = "Days Since First Confirmed Case",
y = "% Local Population Infected Daily") +
theme(plot.title = element_text(size = rel(1), face = "bold"),
plot.subtitle = element_text(size = rel(0.7)),
plot.caption = element_text(size = rel(1))) +
facet_zoom(xlim = c(50,120), ylim=c(0,0.011),zoom.data=zoom)
Data Setup
#source("https://pastebin.com/raw/Vn2abQ4a")
BaseEndpoints <- smDailyBaseData %>%
group_by(Base) %>%
dplyr::filter(DaysSince == max(DaysSince)) %>%
dplyr::select(Base, abbv, DaysSince, newRate,label) %>%
ungroup()
ZoomEndpoints <- BaseEndpoints %>% filter(Base != 'Edwards') %>%
mutate(zoom = TRUE)
CAEndPoint <- BaseEndpoints %>% filter(Base == 'Edwards') %>%
mutate(zoom = FALSE)
ZoomEndpoints <- rbind(ZoomEndpoints, CAEndPoint)
I created an animated bar plot displaying goals scored by players (fictional).
Please see the reproduced data for the example:
df <- data.frame(Player = rep(c("Aguero", "Salah", "Aubameyang", "Kane"), 6),
Team = rep(c("ManCity", "Liverpool", "Arsenal", "Tottenham"), 6),
Gameday = c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6),
Goals = c(0,1,2,0,1,1,3,1,2,1,3,2,2,2,4,3,3,2,4,5,5,3,5,6),
stringsAsFactors = F)
Following animated bar plot are created by the code below.
# loading required
library(tidyverse)
library(gganimate)
library(png)
Edited:
I would like to include following icons for each player:
icon1.png <- image_read('https://raw.githubusercontent.com/sialbi/examples/master/player1.png')
icon2.png <- image_read('https://raw.githubusercontent.com/sialbi/examples/master/player2.png')
icon3.png <- image_read('https://raw.githubusercontent.com/sialbi/examples/master/player3.png')
icon4.png <- image_read('https://raw.githubusercontent.com/sialbi/examples/master/player4.png')
gap <- df %>%
group_by(Gameday) %>%
mutate(rank = min_rank(-Goals) * 1,
Value_rel = Goals/Goals[rank==1],
Value_lbl = paste0(" ", Goals)) %>%
filter(rank <=10) %>%
ungroup()
gap %>%
group_by(Player) %>%
arrange(Gameday) %>%
mutate(prev.rank = lag(rank)) %>%
ungroup() %>%
group_by(Gameday) %>%
arrange(rank, prev.rank) %>%
mutate(x = seq(1, n())) %>%
ungroup() %>%
ggplot(aes(x = x, y = Goals, fill = Player, color = Player)) +
geom_col() +
geom_text(aes(y = 0, label = Player), size = 5, color="black", hjust = -0.05) +
geom_text(aes(label = Value_lbl), hjust = 0) +
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday: {closest_state}", x="", y = "Goals scored") +
theme(plot.title = element_text(hjust = 0, size = 26),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
plot.margin = margin(1,1,1,4, "cm")) +
transition_states(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
Problem
To complete the animation I would like to include a picture of each player on the y axis. Below I edited the animation to display the desired result (the circles were chosen to avoid violating any copyrights).
The images (circles) should also move up and down as the bars.
Is there are way to include images on the y-axis?
Edited Code
After the presented suggestions I was able to fix the problems. The code below is working accordingly.
library(imager)
library(ggimage)
library(magick)
library(tidyverse)
library(gganimate)
library(png)
library(gapminder)
#read data
df <- data.frame(Player = rep(c("Aguero", "Salah", "Aubameyang", "Kane"), 6),
Team = rep(c("ManCity", "Liverpool", "Arsenal", "Tottenham"), 6),
Gameday = c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6),
Goals = c(0,1,2,0,1,1,3,1,2,1,3,2,2,2,4,3,3,2,4,5,5,3,5,6),
stringsAsFactors = F)
# import images
df2 <- data.frame(Player = c("Aguero", "Salah", "Aubameyang", "Kane"),
Image = sample(c("https://raw.githubusercontent.com/sialbi/examples/master/player1.png",
"https://raw.githubusercontent.com/sialbi/examples/master/player2.png",
"https://raw.githubusercontent.com/sialbi/examples/master/player3.png",
"https://raw.githubusercontent.com/sialbi/examples/master/player4.png")),
stringsAsFactors = F)
gap <- df %>%
group_by(Gameday) %>%
mutate(rank = min_rank(-Goals) * 1,
Value_rel = Goals/Goals[rank==1],
Value_lbl = paste0(" ", Goals)) %>%
filter(rank <=10) %>%
ungroup()
p = gap %>%
left_join(df2, by = "Player") %>% # add image file location to the dataframe being
group_by(Player) %>%
arrange(Gameday) %>%
mutate(prev.rank = lag(rank)) %>%
ungroup() %>%
group_by(Gameday) %>%
arrange(rank, prev.rank) %>%
mutate(x = seq(1, n())) %>%
ungroup()
ggplot(p, aes(x = x, y = Goals, fill = Player, color = Player)) +
geom_col() +
geom_text(aes(y = 0, label = Player), size = 5, color="black", hjust = -0.05) +
geom_text(aes(label = Value_lbl), hjust = 0) +
# where the error occurs
geom_image(aes(x = x, Image = Image), y = 0,
size = 0.25, hjust = 1,
inherit.aes = FALSE) +
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday: {closest_state}", x = "", y = "Goals scored") +
theme_classic() +
theme(plot.title = element_text(hjust = 0, size = 26),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
plot.margin = margin(1, 1, 1, 4, "cm")) +
transition_states(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')
You can try the following:
Step 0. Create png images for use, because I don't want to worry about copyright violations either.
emoji.list <- c("grinning", "smile", "heart_eyes", "smirk")
for(i in seq_along(emoji.list)) {
ggsave(paste0("icon", i, ".png"),
ggplot() +
emojifont::geom_emoji(alias = emoji.list[i], size = 10, vjust = 0.5) +
theme_void(),
width = 0.4, height = 0.4, units = "in")
}
rm(emoji.list, i)
Step 1. Create a data frame mapping each player to the location of his image file.
df2 <- data.frame(Player = c("Aguero", "Salah", "Aubameyang", "Kane"),
Image = c("icon1.png", "icon2.png", "icon3.png", "icon4.png"),
stringsAsFactors = F)
Step 2. Add image to plot in a new geom_image layer, & animate everything as before.
library(ggimage)
gap %>%
left_join(df2, by = "Player") %>% # add image file location to the dataframe being
# passed to ggplot()
group_by(Player) %>%
arrange(Gameday) %>%
mutate(prev.rank = lag(rank)) %>%
ungroup() %>%
group_by(Gameday) %>%
arrange(rank, prev.rank) %>%
mutate(x = seq(1, n())) %>%
ungroup() %>%
ggplot(aes(x = x, y = Goals, fill = Player, color = Player)) +
geom_col() +
geom_text(aes(y = 0, label = Player), size = 5, color="black", hjust = -0.05) +
geom_text(aes(label = Value_lbl), hjust = 0) +
geom_image(aes(x = x, image = Image), y = 0, # add geom_image layer
size = 0.25, hjust = 1,
inherit.aes = FALSE) +
coord_flip(clip = "off", expand = FALSE) +
scale_y_continuous(labels = scales::comma) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title = "Gameday: {closest_state}", x = "", y = "Goals scored") +
theme_classic() +
theme(plot.title = element_text(hjust = 0, size = 26),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
plot.margin = margin(1, 1, 1, 4, "cm")) +
transition_states(Gameday, transition_length = 4, state_length = 1) +
ease_aes('cubic-in-out')