I have this dataframe:
library(likert)
library(ggplot2)
DF<-data.frame(A=c(1,2,3,4,5),B=c(2,3,4,5,1),C=c(3,1,2,4,5),D=c(2,3,4,5,1),E=c(1,2,4,3,5))
categories<-c("A","B","C","D","E")
I convert the observations to factors and I create a likert object using the likert package:
DF <- DF %>%
mutate(across(contains(categories), ~ ordered(., levels = c(1,2,3,4,5),labels = c(1,2,3,4,5))))
likert_data<-likert(DF)
Now I create the graph below using the likert.plot function from the same package:
plot(likert_data,plot.percent.neutral=F,center=3.5)
What I would like to do is to change the color of each bar according to the category (A,B,C,D,E), so to get something like this:
The legend doesn't have to be exactly like this. I know how to change the colors of the graph as a whole but don't know how to change the colors of single bars. Do you have any advice? Thanks!
CodePudding user response：
This uses the libraries shades, ggplotify, grid, gtable, and gridExtra.
I'm going to provide the code altogether first. After that, I've broken it down with explanations.
library(likert)
library(tidyverse)
library(shades) # for colors
library(ggplotify) # change back to ggplot
library(gtable)
library(grid)
library(gridExtra)
x = plot(likert_data, plot.percent.neutral = F,
center = 3.5, group = categories)
x
xx <- plot(likert_data, plot.percent.neutral = F,
center = 3.5, group = categories)
theme(legend.position = "none") # <------ no legend
y <- ggplotGrob(xx) # make it a grid object
filling <- which(grepl("#5AB4AC", y$grobs)) # returned 6, 15
#------------- modify the plot -------------
for(each in y$grobs[[6]]$children) { # find where fill used
print(each)
print(each$gp$fill)
}
# make color gradients for new color gradients
rainbow <- c(gradient(c("darkred", "mistyrose"), 3),
gradient(c("#FF7F00", "lightgoldenrod"), 3),
gradient(c("darkgreen", "lightgreen"), 3),
gradient(c("darkblue", "lightblue"), 3),
gradient(c("purple4", "plum"), 3))
# light gray, dark gray
greys = c("gray74", "gray40")
# first pallet has those colors left of the 0 line
# get the light values out of the rainbow of colors
whL <- seq(3, length(rainbow), by = 3)
negs <- c(rev(rainbow[whL]), rep(greys, each = 5))
y$grobs[[6]]$children[[4]]$gp$fill <- negs # add to the plot
# get the remaining colors out of the rainbow
rainGp <- c(seq(2, length(rainbow), by = 3), seq(1, length(rainbow), by = 3))
rainbow2 <- rainbow[rainGp] # select only those that apply
y$grobs[[6]]$children[[5]]$gp$fill <- rainbow2 # add to the plot
grid::grid.draw(y) # take a look using grid
(xx <- as.ggplot(y)) # or you can look as ggplot object (it's the same)
#------------- create the legend -------------
x2 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[1:3])), name = "")
redLeg <- gtable_filter(ggplot_gtable(ggplot_build(x2)), "guide-box")
x3 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[4:6])), name = "")
orgLeg <- gtable_filter(ggplot_gtable(ggplot_build(x3)), "guide-box")
x4 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[7:9])), name = "")
grnLeg <- gtable_filter(ggplot_gtable(ggplot_build(x4)), "guide-box")
x5 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[10:12])), name = "")
bluLeg <- gtable_filter(ggplot_gtable(ggplot_build(x5)), "guide-box")
x6 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[13:15])), name = "")
purLeg <- gtable_filter(ggplot_gtable(ggplot_build(x6)), "guide-box")
# get legends' object names
lgs <- grep("Leg", names(.GlobalEnv), value = T)
# fix order <------- order may be different you on your computer
lgs <- lgs[c(4, 3, 2, 5, 1)]
lgs <- lapply(lgs, get) # capture objects instead of strings
legging <- do.call("rbind", lgs) # make this one gtable instead of 5
gb <- textGrob("Response", x = 1, y = .5, just = c("right", "center"))
arr <- arrangeGrob(grobs = list(gb, legging), widths = c(1, 2),
ncol = 2, nrow = 1, padding = 0)
#------------ the plot's ready --------------
# new plot object
grid.arrange(xx, arr, heights = c(7, 3), nrow = 2, ncol = 1)
All that to get this:
I didn't change the code you provided other than to assign the Likert plot to an object.
I also created another version without the legend. Primarily you'll use the plot without the legend (except when making legends later).
x = plot(likert_data, plot.percent.neutral = F,
center = 3.5, group = categories)
xx <- plot(likert_data, plot.percent.neutral = F,
center = 3.5, group = categories)
theme(legend.position = "none")
Using help, I found that the top default color for Likert plots is #5AB4AC, so I used that information to search the ggplotGrob.
y <- ggplotGrob(xx)
filling <- which(grepl("#5AB4AC", y$grobs)) # returned 6, 15
This returns that the 6th grob and 15th grob contain something assigned to this color. The first is the plot. The second is the legend.
Changing the Plot
Next, I looked further into the color assignment in the plot. I needed to see how the colors were broken down in the background.
for(each in y$grobs[[6]]$children) {
print(each)
print(each$gp$fill)
}
From the for call, I found that I needed to look at the 4th and 5th child within the 6th grob.
This is what was returned from the for statement (truncated to just show the 4th and 5th child).
# rect[geom_rect.rect.871]
# [1] "#F2E5CB" "#F2E5CB" "#F2E5CB" "#F2E5CB" "#F2E5CB" "#E5CC98" "#E5CC98"
# [8] "#E5CC98" "#E5CC98" "#E5CC98" "#D8B365" "#D8B365" "#D8B365" "#D8B365"
# [15] "#D8B365"
# rect[geom_rect.rect.873]
# [1] "#ACD9D5" "#ACD9D5" "#ACD9D5" "#ACD9D5" "#ACD9D5" "#5AB4AC" "#5AB4AC"
# [8] "#5AB4AC" "#5AB4AC" "#5AB4AC"
You can see that the color I mentioned is only in the 5th child. What you see here is that the 4th child has those values to the left of the vertical line for zero on the x-axis. The 5th child has the two highest responses; the two to the right of the vertical zero line.
Next, I created a palette to replace these colors.
rainbow <- c(gradient(c("darkred", "mistyrose"), 3),
gradient(c("#FF7F00", "lightgoldenrod"), 3),
gradient(c("darkgreen", "lightgreen"), 3),
gradient(c("darkblue", "lightblue"), 3),
gradient(c("purple4", "plum"), 3))
I tried a few different methods to make this more dynamic, but the color intensity was really uneven, so I set it manually.
Next, the two grey colors.
# light gray, dark gray
greys = c("gray74", "gray40")
To reset the colors for the 4th child, I need the replacement colors for Likert responses of 1, 2, and 3. So I need to peel the light colors out of the rainbow.
whL <- seq(3, length(rainbow), by = 3)
negs <- c(rev(rainbow[whL]), rep(greys, each = 5))
y$grobs[[6]]$children[[4]]$gp$fill <- negs # add to the plot
Now it's time to change the Likert responses for 4 and 5.
# get the remaining colors out of the rainbow
rainGp <- c(seq(2, length(rainbow), by = 3), seq(1, length(rainbow), by = 3))
rainbow2 <- rainbow[rainGp] # select only those that apply
y$grobs[[6]]$children[[5]]$gp$fill <- rainbow2 # add to the plot
At this point, your plot's colors have all changed.
grid::grid.draw(y) # take a look using grid
(xx <- as.ggplot(y)) # or you can look as ggplot object (it's the same)
Changing the Legend
Instead of reinventing the wheel, I used ggplot to make the legends for me. Essentially, I will plot the graph five times—once for each color group. Each time I plot it, I'll make everything one color group. (For example, the first one only uses shades of red.) After I create the plot, I use gtable to extract the legend.
x2 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[1:3])), name = "")
x2
redLeg <- gtable_filter(ggplot_gtable(ggplot_build(x2)), "guide-box")
x3 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[4:6])), name = "")
x3
orgLeg <- gtable_filter(ggplot_gtable(ggplot_build(x3)), "guide-box")
x4 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[7:9])), name = "")
x4
grnLeg <- gtable_filter(ggplot_gtable(ggplot_build(x4)), "guide-box")
x5 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[10:12])), name = "")
x5
bluLeg <- gtable_filter(ggplot_gtable(ggplot_build(x5)), "guide-box")
x6 <- x scale_fill_manual(values = c(rev(greys), rev(rainbow[13:15])), name = "")
x6
purLeg <- gtable_filter(ggplot_gtable(ggplot_build(x6)), "guide-box")
I could have just added each of these legends to a list, but I just called them to a list instead. Since it searches the environment, there's no telling what order you'll get these back in. I have fixed the order here, but it could be different on your device.
After collecting their names and putting them in order, I get them (change from strings to objects), then I bound them into one gtable.
# get legends' object names
lgs <- grep("Leg", names(.GlobalEnv), value = T)
# fix order <------- order may be different you on your computer
lgs <- lgs[c(4, 3, 2, 5, 1)]
lgs <- lapply(lgs, get) # capture objects instead of strings
legging <- do.call("rbind", lgs) # make this one gtable instead of 5
You could actually see the legends at this point using grid.draw().
Now that I've got the legends, I am going to add the legend label, "Response." (I took it off because it looked odd repeated for each string of colors.)
Next, put the consolidated legends and the label together into one object.
# legend title
gb <- textGrob("Response", x = 1, y = .5, just = c("right", "center"))
# consolidate legend title and legends
arr <- arrangeGrob(grobs = list(gb, legging), widths = c(1, 2),
ncol = 2, nrow = 1, padding = 0)
Next, combine the color-changed plot and the color-changed legend. (You're done!)
# new plot object
grid.arrange(xx, arr, heights = c(6, 4), nrow = 2, ncol = 1)
You may have to adjust the heights here. It's not relative, so depending on how you're using it, you may need to adjust.
