How can I do to insert in the "X axis" the months abbreviations ("xi") instead of the numbers?
I need to switch in the X axis the numbers for months abbreviations ("xi").
Reproductive example
library(ggplot2)
library(dplyr)
x<-c("2014-06","2014-07","2014-08","2014-09","2014-10","2014-11","2014-12")
xi<-c("Jun","Jul","Aug","Sep","Oct","Nov","Dez")
values.observed<-c(3.698,2.132,2.716,4.279,3.918,4.493,4.265)
values.estimated<-c(2.670,2.689,3.078,3.735,3.963,4.238,4.315)
yii<-c(0.629,1.394,1.957,2.677,2.913,3.190,3.299)
yiii<-c(4.567,3.982,4.185,4.785,4.996,5.279,5.349)
df<-data.frame(x,xi,values.observed,values.estimated,yii,yiii)
Year <- seq(min(as.integer(df$x)), max(as.integer(df$x)), by = 1)
df %>%
mutate(x = as.integer(x)) %>%
tidyr::pivot_longer(
cols = starts_with('values'),
names_to = 'group',
values_to = 'values'
) %>%
mutate(group = ifelse(group == "values.observed", "observed", "estimated")) %>%
ggplot(aes(x = x, y = values)) +
geom_line(aes(color = group), size=1.3) +
geom_ribbon(aes(ymin = yii, ymax = yiii), alpha = 0.3, show.legend = FALSE) +
scale_color_manual(values = c(observed = 'green', estimated = 'red'))+
scale_x_continuous(breaks = Year, labels = Year) +
ylab("X") +
xlab("Months") +
theme(axis.text.x = element_text(angle = -15, vjust = 0))
You can group the first geom_line with group and force the second geom_ribbon to take use as.numeric(xi) :
df$xi = factor(df$xi,levels=df$xi)
df %>%
tidyr::pivot_longer(
cols = starts_with('values'),
names_to = 'group',
values_to = 'values'
) %>%
mutate(group = ifelse(group == "values.observed", "observed", "estimated")) %>%
ggplot() +
geom_line(aes(x = xi, y = values,color = group,group = group), size=1.3) +
geom_ribbon(aes(x = as.numeric(xi),y = values,
ymin = yii, ymax = yiii), alpha = 0.3, show.legend = FALSE) +
scale_color_manual(values = c(observed = 'green', estimated = 'red'))+
ylab("X") +
xlab("Months") +
theme(axis.text.x = element_text(angle = -15, vjust = 0))
Or with what you have done, just provide the labels:
labels = split(as.character(df$xi),as.integer(df$xi))
df %>%
mutate(x = as.integer(x)) %>%
tidyr::pivot_longer(
cols = starts_with('values'),
names_to = 'group',
values_to = 'values'
) %>%
mutate(group = ifelse(group == "values.observed", "observed", "estimated")) %>%
ggplot(aes(x = x, y = values)) +
geom_line(aes(color = group), size=1.3) +
geom_ribbon(aes(ymin = yii, ymax = yiii), alpha = 0.3, show.legend = FALSE) +
scale_color_manual(values = c(observed = 'green', estimated = 'red'))+
scale_x_continuous(breaks = as.numeric(names(labels)), labels = labels) +
ylab("X") +
xlab("Months") +
theme(axis.text.x = element_text(angle = -15, vjust = 0))
Related
I have below ggplot:
library(ggplot2)
data = rbind(data.frame('val' = c(10, 30, 15), 'name' = c('A', 'B', 'C'), group = 'gr1'), data.frame('val' = c(30, 40, 12), 'name' = c('A', 'B', 'C'), group = 'gr2'))
ggplot(data, # Draw barplot with grouping & stacking
aes(x = group,
y = val,
fill = name)) +
geom_bar(stat = "identity",
position = "stack", width = .1)
With this, I am getting below plot
However, I want to connect these bars with a curved area where the area would be equal to the value of the corresponding bar-component. A close example could be like,
Is there any way to achieve this with ggplot?
Any pointer will be very helpful.
This is something like an alluvial plot. There are various extension packages that could help you create such a plot, but it is possible to do it in ggplot directly using a bit of data manipulation.
library(tidyverse)
alluvia <- data %>%
group_by(name) %>%
summarize(x = seq(1, 2, 0.01),
val = pnorm(x, 1.5, 0.15) * diff(val) + first(val))
ggplot(data,
aes(x = as.numeric(factor(group)),
y = val,
fill = name)) +
geom_bar(stat = "identity",
position = "stack", width = .1) +
geom_area(data = alluvia, aes(x = x), position = "stack", alpha = 0.5) +
scale_x_continuous(breaks = 1:2, labels = levels(factor(data$group)),
name = "Group", expand = c(0.25, 0.25)) +
scale_fill_brewer(palette = "Set2") +
theme_light(base_size = 20)
EDIT
A more generalized solution for more than 2 groups would be
library(tidyverse)
alluvia <- data %>%
mutate(group = as.numeric(factor(group)),
name = factor(name)) %>%
arrange(group) %>%
group_by(name) %>%
mutate(next_group = lead(group),
next_val = lead(val)) %>%
filter(!is.na(next_val)) %>%
group_by(name, group) %>%
summarise(x = seq(group + 0.01, next_group - 0.01, 0.01),
val = (next_val - val) * pnorm(x, group + 0.5, 0.15) + val)
ggplot(data,
aes(x = as.numeric(factor(group)),
y = val,
fill = name)) +
geom_bar(stat = "identity",
position = "stack", width = .1) +
geom_area(data = alluvia, aes(x = x), position = "stack", alpha = 0.5) +
scale_x_continuous(breaks = seq(length(unique(data$group))),
labels = levels(factor(data$group)),
name = "Group", expand = c(0.25, 0.25)) +
scale_fill_brewer(palette = "Set2") +
theme_light(base_size = 20)
I am trying to create a pie chart to visualize percent abundance of 9 genera. However, the labels are all clumping together. How do I remedy this? Code included below:
generaabundance2020 <- c(883, 464, 1948, 1177, 2607, 962, 2073, 620, 2670)
genera2020 <- c("Andrena", "Ceratina", "Halictus",
"Hesperapis", "Lasioglossum", "Melissodes",
"Osmia", "Panurginus", "Other")
generabreakdown2020 <- data.frame(group = genera2020, value = generaabundance2020)
gb2020label <- generabreakdown2020 %>%
group_by(value) %>% # Variable to be transformed
count() %>%
ungroup() %>%
mutate(perc = `value` / sum(`value`)) %>%
arrange(perc) %>%
mutate(labels = scales::percent(perc))
generabreakdown2020 %>%
ggplot(aes(x = "", y = value, fill = group)) +
geom_col() +
coord_polar("y", start = 0) +
theme_void() +
geom_label_repel(aes(label = gb2020label$labels), position = position_fill(vjust = 0.5),
size = 5, show.legend = F, max.overlaps = 50) +
guides(fill = guide_legend(title = "Genera")) +
scale_fill_manual(values = c("brown1", "chocolate1",
"darkgoldenrod1", "darkgreen",
"deepskyblue", "darkslateblue",
"darkorchid4", "hotpink1",
"lightpink"))
Which produces the following:
Thanks for adding your data.
There are a few errors in your code. The main one is that you didn't precalculate where to place the labels (done here in the text_y variable). That variable needs to be passed as the y aesthetic for geom_label_repel.
The second is that you no longer need
group_by(value) %>% count() %>% ungroup() because the data you provided is already aggregated.
library(tidyverse)
library(ggrepel)
generaabundance2020 <- c(883, 464, 1948, 1177, 2607, 962, 2073, 620, 2670)
genera2020 <- c("Andrena", "Ceratina", "Halictus", "Hesperapis", "Lasioglossum", "Melissodes", "Osmia", "Panurginus", "Other")
generabreakdown2020 <- data.frame(group = genera2020, value = generaabundance2020)
gb2020label <-
generabreakdown2020 %>%
mutate(perc = value/ sum(value)) %>%
mutate(labels = scales::percent(perc)) %>%
arrange(desc(group)) %>% ## arrange in the order of the legend
mutate(text_y = cumsum(value) - value/2) ### calculate where to place the text labels
gb2020label %>%
ggplot(aes(x = "", y = value, fill = group)) +
geom_col() +
coord_polar(theta = "y") +
geom_label_repel(aes(label = labels, y = text_y),
nudge_x = 0.6, nudge_y = 0.6,
size = 5, show.legend = F) +
guides(fill = guide_legend(title = "Genera")) +
scale_fill_manual(values = c("brown1", "chocolate1",
"darkgoldenrod1", "darkgreen",
"deepskyblue", "darkslateblue",
"darkorchid4", "hotpink1",
"lightpink"))
If you want to arrange in descending order of frequency, you should remember to also set the factor levels of the group variable to the same order.
gb2020label <-
generabreakdown2020 %>%
mutate(perc = value/ sum(value)) %>%
mutate(labels = scales::percent(perc)) %>%
arrange(desc(perc)) %>% ## arrange in descending order of frequency
mutate(group = fct_rev(fct_inorder(group))) %>% ## also arrange the groups in descending order of freq
mutate(text_y = cumsum(value) - value/2) ### calculate where to place the text labels
gb2020label %>%
ggplot(aes(x = "", y = value, fill = group)) +
geom_col() +
coord_polar(theta = "y") +
geom_label_repel(aes(label = labels, y = text_y),
nudge_x = 0.6, nudge_y = 0.6,
size = 5, show.legend = F) +
guides(fill = guide_legend(title = "Genera")) +
scale_fill_manual(values = c("brown1", "chocolate1",
"darkgoldenrod1", "darkgreen",
"deepskyblue", "darkslateblue",
"darkorchid4", "hotpink1",
"lightpink"))
Created on 2021-10-27 by the reprex package (v2.0.1)
You didn't provide us with your data to work with so I'm using ggplot2::mpg here.
library(tidyverse)
library(ggrepel)
mpg_2 <-
mpg %>%
slice_sample(n = 20) %>%
count(manufacturer) %>%
mutate(perc = n / sum(n)) %>%
mutate(labels = scales::percent(perc)) %>%
arrange(desc(manufacturer)) %>%
mutate(text_y = cumsum(n) - n/2)
Chart without polar coordinates
mpg_2 %>%
ggplot(aes(x = "", y = n, fill = manufacturer)) +
geom_col() +
geom_label(aes(label = labels, y = text_y))
Chart with polar coordinates and geom_label_repel
mpg_2 %>%
ggplot(aes(x = "", y = n, fill = manufacturer)) +
geom_col() +
geom_label_repel(aes(label = labels, y = text_y),
force = 0.5,nudge_x = 0.6, nudge_y = 0.6) +
coord_polar(theta = "y")
But maybe your data isn’t dense enough to need repelling?
mpg_2 %>%
ggplot(aes(x = "", y = n, fill = manufacturer)) +
geom_col() +
geom_label(aes(label = labels, y = text_y), nudge_x = 0.6) +
coord_polar(theta = "y")
Created on 2021-10-26 by the reprex package (v2.0.1)
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))
My goal is to produce labels with commas, but no decimals. Let's say I have a ggplot with the following section:
geom_text(aes(y = var,
label = scales::comma(round(var))), hjust = 0, nudge_y = 300 )
This is almost what I need. It gives me the commas, but has a decimal. I have seen here (axis labels with comma but no decimals ggplot) that comma_format() could be good, but I think the label in my case needs a data argument, which comma_format() does not take. What can I do?
Update:
As an example of when this problem occurs, see the following, which uses gganimate and has a lot more going on. Code derived from Jon Spring's answer at Animated sorted bar chart with bars overtaking each other
library(gapminder)
library(gganimate)
library(tidyverse)
gap_smoother <- gapminder %>%
filter(continent == "Asia") %>%
group_by(country) %>%
complete(year = full_seq(year, 1)) %>%
mutate(gdpPercap = spline(x = year, y = gdpPercap, xout = year)$y) %>%
group_by(year) %>%
mutate(rank = min_rank(-gdpPercap) * 1) %>%
ungroup() %>%
group_by(country) %>%
complete(year = full_seq(year, .5)) %>%
mutate(gdpPercap = spline(x = year, y = gdpPercap, xout = year)$y) %>%
mutate(rank = approx(x = year, y = rank, xout = year)$y) %>%
ungroup() %>%
arrange(country,year)
gap_smoother2 <- gap_smoother %>% filter(year<=2007 & year>=1999)
gap_smoother3 <- gap_smoother2 %<>% filter(rank<=8)
p <- ggplot(gap_smoother3, aes(rank, group = country,
fill = as.factor(country), color = as.factor(country))) +
geom_tile(aes(y = gdpPercap/2,
height = gdpPercap,
width = 0.9), alpha = 0.8, color = NA) +
geom_text(aes(y = 0, label = paste(country, " ")), vjust = 0.2, hjust = 1) +
geom_text(aes(y = gdpPercap,
label = scales::comma(round(gdpPercap))), hjust = 0, nudge_y = 300 ) +
coord_flip(clip = "off", expand = FALSE) +
scale_x_reverse() +
guides(color = FALSE, fill = FALSE) +
labs(title='{closest_state %>% as.numeric %>% floor}',
x = "", y = "GFP per capita") +
theme(plot.title = element_text(hjust = 0, size = 22),
axis.ticks.y = element_blank(), # These relate to the axes post-flip
axis.text.y = element_blank(), # These relate to the axes post-flip
plot.margin = margin(1,1,1,4, "cm")) +
transition_states(year, transition_length = 1, state_length = 0) +
enter_grow() +
exit_shrink() +
ease_aes('linear')
animate(p, fps = 2, duration = 5, width = 600, height = 500)
In addition to the solution provided by #drf, you need to add scale_y_continuous(scales::comma) to your ggplot commands. But put it before the coord_flip function.
p <- ggplot(gap_smoother3, aes(rank, group = country,
fill = as.factor(country), color = as.factor(country))) +
geom_tile(aes(y = gdpPercap/2,
height = gdpPercap,
width = 0.9), alpha = 0.8, color = NA) +
geom_text(aes(y = gdpPercap,
label = scales::comma(round(gdpPercap), accuracy=1)),
hjust = 0, nudge_y = 300 ) +
scale_y_continuous(labels = scales::comma) +
... etc.
I have created a basketball animation using gganimate, as seen below. You can get the full animation on my blog post (Look at animation under "Paul Pierce Isolation").
Now, there is one problem with this: once the seconds reach single digits, it shows only one digit (7). Its doing what its told to do, but I want it to display (07) so that it closely matches a NBA broadcast.
I'm thinking of using transformers from the glue package, but I'm not sure how I'd do that.
Here is my code:
# Function to grab jersey numbers
grab_jersey <- function(player_id) {
swish_url <- paste0("https://www.swishanalytics.com/nba/players/player?id=", player_id)
swish <- read_html(swish_url)
result <- swish %>%
html_node(".mobile-hide") %>%
html_text() %>%
# Extract out numeric
parse_number()
result
}
## Read in dataset
e.dat_test <- read_csv("https://raw.githubusercontent.com/howardbaek/nba-animation/master/test_df.csv")
# Replace _ent with jersey numbers
a1_ent_jersey <- e.dat_test %>%
pull(a1_ent) %>%
first() %>%
grab_jersey()
a2_ent_jersey <- e.dat_test %>%
pull(a2_ent) %>%
first() %>%
grab_jersey()
a3_ent_jersey <- e.dat_test %>%
pull(a3_ent) %>%
first() %>%
grab_jersey()
a4_ent_jersey <- e.dat_test %>%
pull(a4_ent) %>%
first() %>%
grab_jersey()
a5_ent_jersey <- e.dat_test %>%
pull(a5_ent) %>%
first() %>%
grab_jersey()
h1_ent_jersey <- e.dat_test %>%
pull(h1_ent) %>%
first() %>%
grab_jersey()
h2_ent_jersey <- e.dat_test %>%
pull(h2_ent) %>%
first() %>%
grab_jersey()
h3_ent_jersey <- e.dat_test %>%
pull(h3_ent) %>%
first() %>%
grab_jersey()
h4_ent_jersey <- e.dat_test %>%
pull(h4_ent) %>%
first() %>%
grab_jersey()
h5_ent_jersey <- e.dat_test %>%
pull(h5_ent) %>%
first() %>%
grab_jersey()
# Mutate jersey number columns
e.dat_test <- e.dat_test %>%
mutate(a1_ent_jersey = a1_ent_jersey,
a2_ent_jersey = a2_ent_jersey,
a3_ent_jersey = a3_ent_jersey,
a4_ent_jersey = a4_ent_jersey,
a5_ent_jersey = a5_ent_jersey,
h1_ent_jersey = h1_ent_jersey,
h2_ent_jersey = h2_ent_jersey,
h3_ent_jersey = h3_ent_jersey,
h4_ent_jersey = h4_ent_jersey,
h5_ent_jersey = h5_ent_jersey) %>%
mutate(quarter_processed = case_when(
quarter == 1 ~ "1ST",
quarter == 2 ~ "2ND",
quarter == 3 ~ "3RD",
quarter == 4 ~ "4TH",
TRUE ~ "NA"
)) %>%
mutate(game_clock_minutes = game_clock %/% 60) %>%
mutate(game_clock_seconds = game_clock %% 60)
possid_quarter <- e.dat_test %>%
pull(quarter_processed) %>%
first()
# Save animation as object
anim <- fullcourt() +
# Home Players + Jersey Numbers
geom_point(data = e.dat_test, aes(x = h1_x, y = h1_y, group = possID), size = 6, color = "lightskyblue1") +
geom_text(data = e.dat_test, aes(x = h1_x, y = h1_y, group = possID, label = h1_ent_jersey), color = 'black', alpha = 0.3) +
geom_point(data = e.dat_test, aes(x = h2_x, y = h2_y, group = possID), size = 6, color = "lightskyblue1") +
geom_text(data = e.dat_test, aes(x = h2_x, y = h2_y, group = possID, label = h2_ent_jersey), color = 'black', alpha = 0.3) +
geom_point(data = e.dat_test, aes(x = h3_x, y = h3_y, group = possID), size = 6, color = "lightskyblue1") +
geom_text(data = e.dat_test, aes(x = h3_x, y = h3_y, group = possID, label = h3_ent_jersey), color = 'black', alpha = 0.3) +
geom_point(data = e.dat_test, aes(x = h4_x, y = h4_y, group = possID), size = 6, color = "lightskyblue1") +
geom_text(data = e.dat_test, aes(x = h4_x, y = h4_y, group = possID, label = h4_ent_jersey), color = 'black', alpha = 0.3) +
geom_point(data = e.dat_test, aes(x = h5_x, y = h5_y, group = possID), size = 6, color = "lightskyblue1") +
geom_text(data = e.dat_test, aes(x = h5_x, y = h5_y, group = possID, label = h5_ent_jersey), color = 'black', alpha = 0.3) +
# Away Players
geom_point(data = e.dat_test, aes(x = a1_x, y = a1_y, group = possID), size = 6, color = "salmon1") +
geom_text(data = e.dat_test, aes(x = a1_x, y = a1_y, group = possID, label = a1_ent_jersey), color = 'black', alpha = 0.3) +
geom_point(data = e.dat_test, aes(x = a2_x, y = a2_y, group = possID), size = 6, color = "salmon1") +
geom_text(data = e.dat_test, aes(x = a2_x, y = a2_y, group = possID, label = a2_ent_jersey), color = 'black', alpha = 0.3) +
geom_point(data = e.dat_test, aes(x = a3_x, y = a3_y, group = possID), size = 6, color = "salmon1") +
geom_text(data = e.dat_test, aes(x = a3_x, y = a3_y, group = possID, label = a3_ent_jersey), color = 'black', alpha = 0.3) +
geom_point(data = e.dat_test, aes(x = a4_x, y = a4_y, group = possID), size = 6, color = "salmon1") +
geom_text(data = e.dat_test, aes(x = a4_x, y = a4_y, group = possID, label = a4_ent_jersey), color = 'black', alpha = 0.3) +
geom_point(data = e.dat_test, aes(x = a5_x, y = a5_y, group = possID), size = 6, color = "salmon1") +
geom_text(data = e.dat_test, aes(x = a5_x, y = a5_y, group = possID, label = a5_ent_jersey), color = 'black', alpha = 0.3) +
# Ball
geom_point(data = e.dat_test, aes(x = x, y = y, group = possID), size = 3, color = "gold") +
transition_time(time = -game_clock) +
ggtitle(paste0(possid_quarter, " ", "{-frame_time %/% 60}", ":", "{round(-frame_time %% 60, 0)}")) +
theme(plot.title = element_text(hjust = 0.5))
anim