Here is a reproducible example of a static plot, which I want to animate (I want to show how a MCMC sampler behaves).
library(tidyverse)
library(gganimate)
set.seed(1234)
plot_data <- tibble(x=cumsum(rnorm(100)),
y=cumsum(rnorm(100)),
time=1:length(x))
ggplot(data=plot_data,
aes(x=y, y=x)) +
geom_point() + geom_line()
What I'd like to see is the points being visible when they are drawn and a bit faded (i.e. alpha goes from e.g. 1 to 0.3) afterwards, while there would be a line that only shows the recent history (and ideally fades showing the most recent history the least faded and more than a few steps back totally disappearing).
The following achieves more or less what I want for my points (so in a sense I just want to add fading lines to this connecting the last few points - points fading more slowly across some frames would be even nicer):
ggplot(data=plot_data,
aes(x=y, y=x)) +
geom_point() +
transition_time(time) +
shadow_mark(past = T, future=F, alpha=0.3)
What I am struggling with is how to add two different behaviors for two geoms e.g. point and line. E.g. in the below the points disappear (I don't want them to) and the lines do not fade (I want them to).
p <- ggplot(data=plot_data,
aes(x=y, y=x)) +
geom_point() +
transition_time(time) +
shadow_mark(past = T, future=F, alpha=0.3)
p + geom_line() +
transition_reveal(along = time) +
shadow_mark(past = T, future=F, alpha=0.3)
I had trouble using the built-in shadow_* functions to control more than one behavior at a time; it seemed to just apply the most recent one. (Using gganimate 1.0.3.9000)
One way to get around this is to calculate the transitions manually. For instance, we could copy the data 100 times, one copy for each frame, and then specify the alpha for our points layer and the alpha for our segment layer separately.
plot_data %>%
uncount(100, .id = "frame") %>%
filter(time <= frame) %>%
arrange(frame, time) %>%
group_by(frame) %>%
mutate(x_lag = lag(x),
y_lag = lag(y),
tail = last(time) - time,
# Make the points solid for 1 frame then alpha 0.3
point_alpha = if_else(tail == 0, 1, 0.3),
# Make the lines fade out over 20 frames
segment_alpha = pmax(0, (20-tail)/20)) %>%
ungroup() %>%
ggplot(aes(x=y, y=x, xend = y_lag, yend = x_lag, group = time)) +
geom_segment(aes(alpha = segment_alpha)) +
geom_point(aes(alpha = point_alpha)) +
scale_alpha(range = c(0,1)) +
guides(alpha = F) +
transition_manual(frame)
(For this render, I wrapped it in animate( [everything above], width = 600, height = 400, type = "cairo"))
Related
I am working on a boxplot with points overlayed and lines connecting the points between two time sets, example data provided below.
I have two questions:
I would like the points to look like this, with just a little height jitter and more width jitter. However, I want the points to be symmetrically centered around the middle of the boxplot on each y axis label (to make the plots more visually pleasing). For example, I would like the 6 datapoints at y = 4 and x = "after to be placed 3 to the right of the boxplot center and 3 to the left of the center, at symmetrical distances from the center.
Also, I want the lines to connect with the correct points, but now the lines start and end in the wrong places. I know I can use position = position_dodge() in geom_point() and geom_line() to get the correct positions, but I want to be able to adjust the points by height also (why do the points and lines align with position_dodge() but not with position_jitter?).
Are these to things possible to achieve?
Thank you!
examiner <- rep(1:15, 2)
time <- rep(c("before", "after"), each = 15)
result <- c(1,3,2,3,2,1,2,4,3,2,3,2,1,3,3,3,4,4,5,3,4,3,2,2,3,4,3,4,4,3)
data <- data.frame(examiner, time, result)
ggplot(data, aes(time, result, fill=time)) +
geom_boxplot() +
geom_point(aes(group = examiner),
position = position_jitter(width = 0.2, height = 0.03)) +
geom_line(aes(group = examiner),
position = position_jitter(width = 0.2, height = 0.03), alpha = 0.3)
I'm not sure that you can satisfy both of your questions together.
You can have a more "symmetric" jitter by using a geom_dotplot, as per:
ggplot(data, aes(time, result, fill=time)) +
geom_boxplot() +
geom_dotplot(binaxis="y", aes(x=time, y=result, group = time),
stackdir = "center", binwidth = 0.075)
The problem is that when you add the lines, they will join at the original, un-jittered points.
To join jittered points with lines that map to the jittered points, the jitter can be added to the data before plotting. As you saw, jittering both ends up with points and lines that don't match. See Connecting grouped points with lines in ggplot for a better explanation.
library(dplyr)
data <- data %>%
mutate(result_jit = jitter(result, amount=0.1),
time_jit = jitter(case_when(
time == "before" ~ 2,
time == "after" ~ 1
), amount=0.1)
)
ggplot(data, aes(time, result, fill=time)) +
geom_boxplot() +
geom_point(aes(x=time_jit, y=result_jit, group = examiner)) +
geom_line(aes(x=time_jit, y=result_jit, group = examiner), alpha=0.3)
Result
It is possible to extract the transformed points from the geom_dotplot using ggplot_build() - see Is it possible to get the transformed plot data? (e.g. coordinates of points in dot plot, density curve)
These points can be merged onto the original data, to be used as the anchor points for the geom_line.
Putting it all together:
library(dplyr)
library(ggplot2)
examiner <- rep(1:15, 2)
time <- rep(c("before", "after"), each = 15)
result <- c(1,3,2,3,2,1,2,4,3,2,3,2,1,3,3,3,4,4,5,3,4,3,2,2,3,4,3,4,4,3)
# Create a numeric version of time
data <- data.frame(examiner, time, result) %>%
mutate(group = case_when(
time == "before" ~ 2,
time == "after" ~ 1)
)
# Build a ggplot of the dotplot to extract data
dotpoints <- ggplot(data, aes(time, result, fill=time)) +
geom_dotplot(binaxis="y", aes(x=time, y=result, group = time),
stackdir = "center", binwidth = 0.075)
# Extract values of the dotplot
dotpoints_dat <- ggplot_build(dotpoints)[["data"]][[1]] %>%
mutate(key = row_number(),
x = as.numeric(x),
newx = x + 1.2*stackpos*binwidth/2) %>%
select(key, x, y, newx)
# Join the extracted values to the original data
data <- arrange(data, group, result) %>%
mutate(key = row_number())
newdata <- inner_join(data, dotpoints_dat, by = "key") %>%
select(-key)
# Create final plot
ggplot(newdata, aes(time, result, fill=time)) +
geom_boxplot() +
geom_dotplot(binaxis="y", aes(x=time, y=result, group = time),
stackdir = "center", binwidth = 0.075) +
geom_line(aes(x=newx, y=result, group = examiner), alpha=0.3)
Result
I'm drawing a scatterplot where I'd like to highlight different observations as time passes. Sometimes, these observations are close together, so I'm using geom_label_repel to do so. I'd also like to use enter_fade and exit_fade in order to make smoother the transition between phases of the animation.
I see from elsewhere (eg here) that the position of the geom_label_repel can be made consistent with the use of a seed. However, this isn't working for me with enter_fade and exit_fade: the geom_label_repel jumps around as the labels enter and exit.
Is there a way that the geom_label_repel can stay where it is through these phases?
Here's an example of how I've attempted to implement this, which hopefully will illustrate the problem I'm running into.
set.seed(24601)
library(stringi)
library(tidyverse)
library(gganimate)
library(ggrepel)
x <-
rnorm(100, 0, 1)
y <-
rnorm(100, 0, 1)
names <-
stri_rand_strings(100,
5)
categories <-
rep(c("a", "b", "c", "d", "e"), 5)
ggplot(data.frame(x, y, names, categories)) +
aes(x = x,
y = y) +
geom_point(data = . %>%
select(- categories)) +
geom_label_repel(aes(label = names,
group = categories),
seed = 24601) +
transition_states(categories) +
enter_fade() +
exit_fade()
What's happening is that during the transitions, the location and number of labels within the plot are not consistent. This causes geom_label_repel() to force labels away from each other. You can set force = 0 so that your labels are not repelled from each other (default force is 1), but instead only repelled from points.
ggplot(data.frame(x, y, names, categories)) +
aes(x = x,
y = y) +
geom_point(data = . %>%
select(- categories)) +
geom_label_repel(aes(label = names,
group = categories),
seed = 24601,
force = 0) +
transition_states(categories) +
enter_fade() +
exit_fade()
As you can see, you will have some labels overlap. However, if important, you could play with lower values of force (e.g. force = 0.1) so the labels only shift slightly but overlap less.
Although most are stable, I am getting a couple of random labels popping up and not transitioning, will investigate.
I'm aware there are similar posts but I could not get those answers to work in my case.
e.g. Here and here.
Example:
diamonds %>%
ggplot(aes(scale(price) %>% as.vector)) +
geom_density() +
xlim(-3, 3) +
facet_wrap(vars(cut))
Returns a plot:
Since I used scale, those numbers are the zscores or standard deviations away from the mean of each break.
I would like to add as a row underneath the equivalent non scaled raw number that corresponds to each.
Tried:
diamonds %>%
ggplot(aes(scale(price) %>% as.vector)) +
geom_density() +
xlim(-3, 3) +
facet_wrap(vars(cut)) +
geom_text(aes(label = price))
Gives:
Error: geom_text requires the following missing aesthetics: y
My primary question is how can I add the raw values underneath -3:3 of each break? I don't want to change those breaks, I still want 6 breaks between -3:3.
Secondary question, how can I get -3 and 3 to actually show up in the chart? They have been trimmed.
[edit]
I've been trying to make it work with geom_text but keep hitting errors:
diamonds %>%
ggplot(aes(x = scale(price) %>% as.vector)) +
geom_density() +
xlim(-3, 3) +
facet_wrap(vars(cut)) +
geom_text(label = price)
Error in layer(data = data, mapping = mapping, stat = stat, geom = GeomText, :
object 'price' not found
I then tried changing my call to geom_text()
geom_text(data = diamonds, aes(price), label = price)
This results in the same error message.
You can make a custom labeling function for your axis. This takes each label on the axis and performs a custom transform for you. In your case you could paste the z score, a line break, and the z-score times the standard deviation plus the mean. Because of the distribution of prices in the diamonds data set, this means that z scores below about -1 represent negative prices. This may not be a problem in your own data. For clarity I have drawn in a vertical line representing $0
labeller <- function(x) {
paste0(x,"\n", scales::dollar(sd(diamonds$price) * x + mean(diamonds$price)))
}
diamonds %>%
ggplot(aes(scale(price) %>% as.vector)) +
geom_density() +
geom_vline(aes(xintercept = -0.98580251364833), linetype = 2) +
facet_wrap(vars(cut)) +
scale_x_continuous(label = labeller, limits = c(-3, 3)) +
xlab("price")
We can use the sec_axis functionality in scale_x_continuous. To use this functionality we need to manually scale your data. This will add a secondary axis at the top of the plot, not underneath. So it's not quite exactly what you're looking for.
library(tidyverse)
# manually scale the data
mean_price <- mean(diamonds$price)
sd_price <- sd(diamonds$price)
diamonds$price_scaled <- (diamonds$price - mean_price) / sd_price
# make the plot
ggplot(diamonds, aes(price_scaled))+
geom_density()+
facet_wrap(~cut)+
scale_x_continuous(sec.axis = sec_axis(~ mean_price + (sd_price * .)),
limits = c(-3, 4), breaks = -3:3)
You could cheat a bit by passing some dummy data to geom_text:
geom_text(data = tibble(label = round(((-3:3) * sd_price) + mean_price),
y = -0.25,
x = -3:3),
aes(x, y, label = label))
Let's say I have the following graph:
library(ggplot2)
library(ggthemes)
library(extrafont)
charts.data <- read.csv("copper-data-for-tutorial.csv")
p1 <- ggplot() + geom_line(aes(y = export, x = year, colour = product),
data = charts.data, stat="identity")
p1
I'm looking for a general strategy (or perhaps a library) that "builds up" ggplots one line at a time. So the output would consist of two images, one with just the red line, and the next with the red and the blue line, to be used as adjacent slides in, say, a powerpoint presentation.
The key is filter for copper only in one, then to use ylim in both to keep the transition from one graph to the next smooth.
# copper only
df %>%
filter(product == "copper") %>%
ggplot() +
geom_line(aes(y = export, x = year, colour = product),
stat = "identity") +
ylim(0, 16000)
# both
df %>%
ggplot() +
geom_line(aes(y = export, x = year, colour = product),
stat = "identity") +
ylim(0, 16000)
Goal
I would like to zoom in on the GDP of Europe throughout the years. The phantastic ggforce::facet_zoom allows this for static plots (i.e., for one specific year) very easily.
Moving scales, however, prove harder than expected. gganimate seems to take the x-axis limits from the first frame (year == 1952) and continute until the end of the animation. This related, but code-wise outdated question did not yield an answer, unfortunately. Neither + coord_cartesian(xlim = c(from, to)), nor facet_zoom(xlim = c(from, to)) seems to be able to influence the facet_zoom window beyond static limits.
Is there any way to make gganimate 'recalculate' the facet_zoom scales for every frame?
Ideal result
First frame
Last frame
Current code
library(gapminder)
library(ggplot2)
library(gganimate)
library(ggforce)
p <- ggplot(gapminder, aes(gdpPercap, lifeExp, size = pop, color = continent)) +
geom_point() + scale_x_log10() +
facet_zoom(x = continent == "Europe") +
labs(title = "{frame_time}") +
transition_time(year)
animate(p, nframes = 30)
I don't think it's possible quite yet with the current dev version of gganimate as of Dec 2018; there seem to be some bugs which prevent facet_zoom from playing nice with gganimate. Fortunately, I don't think a workaround is too painful.
First, we can tween to fill in the intermediate years:
# Here I tween by fractional years for more smooth movement
years_all <- seq(min(gapminder$year),
max(gapminder$year),
by = 0.5)
gapminder_tweened <- gapminder %>%
tweenr::tween_components(time = year,
id = country,
ease = "linear",
nframes = length(years_all))
Then, adopting your code into a function that takes a year as input:
render_frame <- function(yr) {
p <- gapminder_tweened %>%
filter(year == yr) %>%
ggplot(aes(gdpPercap, lifeExp, size = pop, color = continent)) +
geom_point() +
scale_x_log10(labels = scales::dollar_format(largest_with_cents = 0)) +
scale_size_area(breaks = 1E7*10^0:3, labels = scales::comma) +
facet_zoom(x = continent == "Europe") +
labs(title = round(yr + 0.01) %>% as.integer)
# + 0.01 above is a hack to override R's default "0.5 rounds to the
# closest even" behavior, which in this case gives more frames
# (5 vs. 3) to the even years than the odd years
print(p)
}
Finally, we can save an animation by looping through through the years (which in this case include fractional years):
library(animation)
oopt = ani.options(interval = 1/10)
saveGIF({for (i in 1:length(years_all)) {
render_frame(years_all[i])
print(paste0(i, " out of ",length(years_all)))
ani.pause()}
},movie.name="facet_zoom.gif",ani.width = 400, ani.height = 300)
or, alternatively, using gifski for a smaller file <2MB:
gifski::save_gif({ for (i in 1:length(years_all) {
render_frame(years_all[i])
print(paste0(i, " out of ",length(years_all)))
}
},gif_file ="facet_zoom.gif", width = 400, height = 300, delay = 1/10, progress = TRUE)
(When I have more time, I'll try to remove the distracting changes in the legends by using manually specified breaks.)