Recently, I wrote a post about creating control charts in R, and now I want to experiment with animating one of those charts.
Lets start with the
library(tidyverse) library(gganimate) library(ggQC)
Now, lets rebuild the last control chart from my previous post.
# Generate sample data set.seed(20190117) example_df <- data_frame(values = rnorm(n=30*5, mean = 25, sd = .005), subgroup = rep(1:30, 5), n = rep(1:5, each = 30)) %>% add_row(values = rnorm(n=2*5, mean = 25 + .006, sd = .005), subgroup = rep(31:32, 5), n = rep(1:5, each = 2)) violations <- example_df %>% QC_Violations(value = "values", grouping = "subgroup", method = "xBar.rBar") %>% filter(Violation == TRUE) %>% select(data, Index) %>% unique() ggQC_example <- example_df %>% ggplot(aes(x = subgroup, y = values)) + stat_summary(fun.y = mean, geom = "line", aes(group = 1)) + stat_summary(fun.y = mean, geom = "point", aes(group = 1)) + stat_QC(method = "xBar.rBar", auto.label = TRUE, label.digits = 4) + scale_x_continuous(expand = expand_scale(mult = c(.05, .15))) + # Pad the x-axis for the labels ylab("x-bar") + theme_bw() + geom_point(data = violations, aes(x = Index, y = data), color = "red", group = 1) ggQC_example
You can see that I added some grouping variables to try to control the annimation, but I couldn’t get it to look right. Take a look:
ggQC_example + transition_reveal(subgroup)
Ok, setting the red points asside, the graph seems to recalculate the control limits for each frame. Let’s try making the same plot from a tidy dataset, and see if that annimates a little more nicely.
UCL <- xBar_rBar_UCL(data = example_df, value = "values", grouping = "subgroup") LCL <- xBar_rBar_LCL(data = example_df, value = "values", grouping = "subgroup") take_two_df <- example_df %>% group_by(subgroup) %>% summarise(point = mean(values)) %>% # caluculate the x-bar points left_join(violations, by = c("subgroup" = "Index"), suffix = c("normal", "violation")) %>% # add the information about which points are out-of-control mutate(control = case_when( # supply missing information from the join is.na(data) ~ "out", TRUE ~ "in" )) take_two <- take_two_df %>% ggplot(aes(x = subgroup, y = point)) + geom_line() + geom_point(aes(group = subgroup, color = control)) + # adding the group aes keeps the points from dissapearing geom_hline(yintercept = c(LCL, UCL), color = "red") + # usin geom_hline keeps the line from annimating geom_hline(yintercept = (UCL + LCL) / 2, alpha = .5) + xlab("x-bar") + ylab("subgroup") + scale_color_manual(values = c("red", "black")) + # manually color the in-control vs out-of-control points ggtitle("Annimated Control Chart") + theme_bw() + theme(legend.position = "none") + # the legend is self-explanatory transition_reveal(subgroup) # specify the annimation animate(take_two, end_pause = 10) # using the animate() function allows me to set the end_pause
Sure enough, that worked much more nicely. The lesson learned is that items that are calculated at the time of plotting act differently from those that are simply data being thrown on a graph. I couldn’t figure out how to get
stat_QC (which is calculated at run-time when plotting) to remain static, so I had to create a tidy dataset with all the information that I needed.
ggannimate makes annimations way easier than trying to creating all of those individual plots on their own and then combining them into a .gif. It would only be 32 plots if I wanted it to jump from point-to-point, but notice that the lines also get drawn rather than jumping.