Mike S
Mike S

Reputation: 306

R ggplot for series with change % displayed

I have this bar plot and thinking how I can catch pairs which let say have change > 20%, or best solution would be display that percentage on the plot, like on mocked picture. I just got feeling that R packs can do everything..

library(tidyverse)

df1 <-  data.frame(yy=2017,  F1=11, F2=11, F3=16)
df2 <-  data.frame(yy=2018,  F1=13, F2=33, F3=22)
df <- rbind(df1,df2)

df %>% 
  gather(type,value,-yy) %>%           # reshape data
  mutate(yy = factor(yy)) %>%          # update variable to a factor
  ggplot(aes(type, value, fill=yy)) +
  geom_bar(stat = "identity", position = "dodge")

enter image description here

Upvotes: 1

Views: 615

Answers (2)

Maurits Evers
Maurits Evers

Reputation: 50718

Do you mean something like this?

library(tidyr);
library(dplyr);
library(ggplot2);


df %>%
  gather(type, value, -yy) %>%           # reshape data
  mutate(yy = factor(yy)) %>%          # update variable to a factor
  ggplot(aes(type, value, fill = yy, text = yy)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(
      aes(y = value, label = scales::percent(value / sum(value))), 
      vjust = -0.5, 
      position = position_dodge(width = 1))

enter image description here


Or if it is percentage change per type that you are after (as suggested by @neilfs) you could do:

df %>%
  gather(type, value, -yy) %>%
  mutate(yy = factor(yy)) %>%
  group_by(type) %>%
  mutate(change = (value - lag(value)) / lag(value)) %>%
  mutate(change = if_else(is.na(change), 0, change)) %>%
  ggplot(aes(type, value, fill = yy, text = yy)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(
      aes(y = value, label = scales::percent(change)),
      vjust = -0.5,
      position = position_dodge(width = 1))

enter image description here

Or if you don't want the "0%" labels,

percent_format <- function(x, nplaces = 2) {
    x <- plyr::round_any(x, 10 ^ (-(nplaces + 2)));
    s <- rep("", length(x));
    s[x > 0] <- paste0(scales::comma(x[x > 0] * 100), "%");
    return(s);
}

df %>%
  gather(type, value, -yy) %>%
  mutate(yy = factor(yy)) %>%
  group_by(type) %>%
  mutate(change = (value - lag(value)) / lag(value)) %>%
  mutate(change = if_else(is.na(change), 0, change)) %>%
  ggplot(aes(type, value, fill = yy, text = yy)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(
      aes(y = value, label = percent_format(change, 2)),
      vjust = -0.5,
      position = position_dodge(width = 1))

enter image description here

Lastly, if you prefer the labels to be centred, just remove position = position_dodge(width = 1).


Sample data

df1 <-  data.frame(yy=2017,  F1=11, F2=11, F3=16)
df2 <-  data.frame(yy=2018,  F1=13, F2=33, F3=22)
df <- rbind(df1,df2)

Upvotes: 4

erocoar
erocoar

Reputation: 5893

Could maybe do

library(tidyverse)

df1 <-  data.frame(yy=2017,  F1=11, F2=11, F3=16)
df2 <-  data.frame(yy=2018,  F1=13, F2=33, F3=22)
df <- rbind(df1,df2)


perc <- (df[2, 2:4] - df[1, 2:4]) / df[1, 2:4] * 100
perc <- paste0(round(perc, 2), "%")

df_tidy <- df %>% 
  gather(type,value,-yy) %>%           # reshape data
  mutate(yy = factor(yy))             # update variable to a factor

ggplot() +
  geom_bar(data = df_tidy, aes(type, value, fill=yy), stat = "identity", position = "dodge") + 
  geom_text(aes(x = 1:length(unique(df_tidy$type)), y = apply(df[, 2:4], 2, max) + 1, label = perc))

That gives

enter image description here

Upvotes: 0

Related Questions