Update: Sorry I forgot to add the vector:
time=1:100
value = 1:67
fill = rep(max(value), 100-max(value))
I want to make an animated stacked bar, Here is my example:
library(tidyverse)
library(gganimate)
#example data frame
df <- tibble(time = time,
value = c(value, fill),
x = "A") %>%
mutate(fill_color = "gold") %>%
mutate(gold_nr = value) %>%
mutate(blue_nr = rev(gold_nr)) %>%
pivot_longer(c(gold_nr, blue_nr),
names_to = "color_group",
values_to = "value_group")
# the code:
p <- df %>%
ggplot(aes("", value_group, fill=color_group)) +
geom_col(width = 0.3, position = position_fill())+
scale_fill_manual(values = c("gold", "steelblue"))+
theme_minimal()+
# theme(legend.position="none")+
transition_manual(value)+
coord_flip()
animate(p, fps=24, renderer = gifski_renderer(loop = FALSE))
My question is: Why does the bar not stop at 67 and jumps over 75?
I think I have to organize the data in a other way?
You should use time column to group the frames.
tail(df, 4)
# time fill_color color_group value_group
# 197 99 gold gold_nr 67
# 198 99 gold blue_nr 2
# 199 100 gold gold_nr 67
# 200 100 gold blue_nr 1
The plot now shows correctly the proportions in the last time frame.
proportions(df[df$time == 100, ]$value_group)
# [1] 0.98529412 0.01470588
library('magrittr')
p <- df %>%
ggplot2::ggplot(ggplot2::aes("", value_group, fill=color_group)) +
ggplot2::geom_col(width=0.3, position=position_fill()) +
ggplot2::scale_fill_manual(values=c("steelblue", "gold")) +
ggplot2::theme_minimal() +
ggplot2::coord_flip() +
gganimate::transition_manual(time)
a <- gganimate::animate(p, fps=24, renderer=gifski_renderer(loop=TRUE))
gganimate::anim_save('a.gif', a)
Note, that your colors were flipped.
Related
I am trying to plot multiple paths in a gganimate plot. I want the lines to fade out over the last N frames (e.g. N=5 in this example).
The data look like this:
set.seed(27)
df <- data.frame(Frame = rep(1:10, 3),
id = factor(rep(1:3, each = 10)),
x = runif(30),
y = runif(30))
head(df)
Frame id x y
1 1 1 0.97175023 0.14257923
2 2 1 0.08375751 0.47864658
3 3 1 0.87386992 0.05182206
4 4 1 0.32923136 0.25514379
5 5 1 0.22227551 0.14262912
6 6 1 0.40164822 0.48288482
I tried to make the plot using shadow_mark, but this doesn't appear to have the lines fade out over time.
df %>%
ggplot(aes(x = x, y = y, group = id, color = id)) +
geom_path() +
geom_point()+
scale_color_manual(values=c("red","blue","green")) +
transition_reveal(along = Frame) +
shadow_mark(size = 0.75) +
theme_void()
This just produces the below:
Is there a way to make these lines fade. Ideally, I'm just plotting a rolling path of N frames.
Is this something like what you're looking for? Adapted from the post mentioned in the comments. You don't need to use transition_reveal() if you use geom_segment().
library(gganimate)
library(dplyr)
library(tidyr)
set.seed(27)
n <- 10
df <- data.frame(Frame = rep(1:n, 3),
id = factor(rep(1:3, each = n)),
x = runif(3*n),
y = runif(3*n))
newdf <- df %>%
uncount(n, .id = "newframe") %>%
filter(Frame <= newframe) %>%
arrange(newframe, Frame) %>%
group_by(newframe, id) %>%
mutate(x_lag = lag(x),
y_lag = lag(y),
tail = last(Frame) - Frame,
# Make the points solid for 1 frame then alpha 0
point_alpha = if_else(tail == 0, 1, 0),
# Make the lines fade out over 3 frames
segment_alpha = pmax(0, (3-tail)/3)) %>%
ungroup()
ggplot(newdf,
aes(x = y, y = x, xend = y_lag, yend = x_lag, group = Frame, color = id)) +
geom_segment(aes(alpha = segment_alpha)) +
geom_point(aes(alpha = point_alpha)) +
scale_alpha(range = c(0,1)) +
guides(alpha = F) +
transition_manual(newframe) +
theme_void() +
scale_color_manual(values = c("red","blue","green"))
Suppose I wish to make a range plot with the design below using ggplot with the following dummy data:
with following legend.
set.seed(1)
test.dat <- data.frame(
yval = sample(1:100, 40),
xcat = rep(LETTERS[1:4], 10),
base = sample(c(1, 0),40, replace=T),
col = rep(c("red", "blue"), 40)
)
> head(test.dat)
yval xcat base col
1 68 A 0 red
2 39 B 0 blue
3 1 C 0 red
4 34 D 1 blue
5 87 A 0 red
6 43 B 0 blue
The gray portion shows the range of the data where base == 1 and the whisker-like line (that resembles errorbar) shows the range of the data where base == 0 using the respective color designed for each xcat.
So using this dummy data, I would expect:
minmax <- function(x){
return(
c(min(x),max(x))
)
}
> minmax(test.dat[test.dat$xcat == "D" & test.dat$base == 1,]$yval)
[1] 24 99
> minmax(test.dat[test.dat$xcat == "D" & test.dat$base == 0,]$yval)
[1] 21 82
> unique(test.dat[test.dat$xcat == "D",]$col)
[1] "blue"
for xcat == "D", a gray bar to range from 24 to 99, and a blue whisker line to range from 21 to 82.
How can I achieve this? It looks like there is no straightforward ggplot function to create a range plot.
My approach idea was to adjust geom_boxplot's hinges and whisper definition for gray part, and use geom_line or geom_linerange to create the whisker-line part, but I am unsure how to do that.
Thank you.
You first create a dataframe where you have min and max for each combination of (xcat, base and col)
data2 <- test.dat %>% group_by(xcat, base, col) %>% summarise(min = min(yval), max=max(yval))
Then you use geom_linerange for the gray "bars" and geom_errorbar for the whisker line:
ggplot()+
geom_linerange(data= data2 %>% filter(base==1), aes(x= xcat, ymin=min, ymax=max), size=12, alpha=0.5)+
geom_errorbar(data= data2 %>% filter(base==0), aes(x= xcat, ymin=min, ymax=max), colour=data2[data2$base==1,]$col, width=.2)
And this is the
Plot
I would suggest doing some reshaping first using dplyr/tidyr, and then geom_tile:
library(tidyverse)
test.dat %>%
group_by(xcat, base, col) %>%
summarize(mid = mean(range(yval)),
range = diff(range(yval)), .groups = "drop") %>%
pivot_wider(names_from = base, values_from = mid:range) %>%
ggplot(aes(x = xcat)) +
geom_tile(aes(y = mid_0, height = range_0), fill = "gray70", color = "black") +
geom_tile(aes(y = mid_1, height = range_1, fill = col), color = "black") +
scale_fill_identity()
What I'm doing
I'm using a library for R called ggplot2, which allows for a lot of different options for creating graphics and other things. I'm using that to display two different data sets on one graph with different colours for each set of data I want to display.
The Problem
I'm also trying to get a legend to to show up in my graph that will tell the user which set of data corresponds to which colour. So far, I've not been able to get it to show.
What I've tried
I've set it to have a position at the top/bottom/left/right to make sure nothing was making it's position to none by default, which would've hidden it.
The Code
# PDF/Plot generation
pdf("activity-plot.pdf")
ggplot(data.frame("Time"=times), aes(x=Time)) +
#Data Set 1
geom_density(fill = "#1A3552", colour = "#4271AE", alpha = 0.8) +
geom_text(x=mean(times)-1, y=max(density(times)$y/2), label="Mean {1} Activity", angle=90, size = 4) +
geom_vline(aes(xintercept=mean(times)), color="cyan", linetype="dashed", size=1, alpha = 0.5) +
# Data Set 2
geom_density(data=data.frame("Time"=timesSec), fill = "gray", colour = "orange", alpha = 0.8) +
geom_text(x=mean(timesSec)-1, y=max(density(timesSec)$y/2), label="Mean {2} Activity", angle=90, size = 4) +
geom_vline(aes(xintercept=mean(timesSec)), color="orange", linetype="dashed", size=1, alpha = 0.5) +
# Main Graph Info
labs(title="Activity in the past 48 hours", subtitle="From {DATE 1} to {DATE 2}", caption="{LOCATION}") +
scale_x_continuous(name = "Time of Day", breaks=seq(c(0:23))) +
scale_y_continuous(name = "Activity") +
theme(legend.position="top")
dev.off()
Result
As pointed out by #Ben, you should pass the color into an aes in order to get the legend being displayed.
However, a better way to get a ggplot is to merge your two values "Time" and "Timesec" into a single dataframe and reshape your dataframe into a longer format. Here, to illustrate this, I created this dummy dataframe:
Time = sample(1:24, 200, replace = TRUE)
Timesec = sample(1:24, 200, replace = TRUE)
df <- data.frame(Time, Timesec)
Time Timesec
1 22 23
2 21 9
3 19 9
4 10 6
5 7 24
6 15 9
... ... ...
So, the first step is to reshape your dataframe into a longer format. Here, I'm using pivot_longer function from tidyr package:
library(tidyr)
library(dplyr)
df %>% pivot_longer(everything(), names_to = "var",values_to = "val")
# A tibble: 400 x 2
var val
<chr> <int>
1 Time 22
2 Timesec 23
3 Time 21
4 Timesec 9
5 Time 19
6 Timesec 9
7 Time 10
8 Timesec 6
9 Time 7
10 Timesec 24
# … with 390 more rows
To add geom_vline and geom_text based on the mean of your values, a nice way of doing it easily is to create a second dataframe gathering the mean and the maximal density values needed to be plot:
library(tidyr)
library(dplyr)
df_lab <- df %>% pivot_longer(everything(), names_to = "var",values_to = "val") %>%
group_by(var) %>%
summarise(Mean = mean(val),
Density = max(density(val)$y))
# A tibble: 2 x 3
var Mean Density
<chr> <dbl> <dbl>
1 Time 11.6 0.0555
2 Timesec 12.1 0.0517
So, using df and df_lab, you can generate your entire plot. Here, we passed color and fill arguments into the aes and use scale_color_manual and scale_fill_manual to set appropriate colors:
library(dplyr)
library(tidyr)
library(ggplot2)
df %>% pivot_longer(everything(), names_to = "var",values_to = "val") %>%
ggplot(aes(x = val, fill = var, colour = var))+
geom_density(alpha = 0.8)+
scale_color_manual(values = c("#4271AE", "orange"))+
scale_fill_manual(values = c("#1A3552", "gray"))+
geom_vline(inherit.aes = FALSE, data = df_lab,
aes(xintercept = Mean, color = var), linetype = "dashed", size = 1,
show.legend = FALSE)+
geom_text(inherit.aes = FALSE, data = df_lab,
aes(x = Mean-0.5, y = Density/2, label = var, color = var), angle = 90,
show.legend = FALSE)+
labs(title="Activity in the past 48 hours", subtitle="From {DATE 1} to {DATE 2}", caption="{LOCATION}") +
scale_x_continuous(name = "Time of Day", breaks=seq(c(0:23))) +
scale_y_continuous(name = "Activity") +
theme(legend.position="top")
Does it answer your question ?
I want to plot the rolling mean of data of different time series with ggplot2. My data have the following structure:
library(dplyr)
library(ggplot2)
library(zoo)
library(tidyr)
df <- data.frame(episode=seq(1:1000),
t_0 = runif(1000),
t_1 = 1 + runif(1000),
t_2 = 2 + runif(1000))
df.tidy <- gather(df, "time", "value", -episode) %>%
separate("time", c("t", "time"), sep = "_") %>%
subset(select = -t)
> head(df.tidy)
# episode time value
#1 1 0 0.7466480
#2 2 0 0.7238865
#3 3 0 0.9024454
#4 4 0 0.7274303
#5 5 0 0.1932375
#6 6 0 0.1826925
Now, the code below creates a plot where the lines for time = 1 and time = 2 towards the beginning of the episodes do not represent the data because value is filled with NAs and the first numeric entry in value is for time = 0.
ggplot(df.tidy, aes(x = episode, y = value, col = time)) +
geom_point(alpha = 0.2) +
geom_line(aes(y = rollmean(value, 10, align = "right", fill = NA)))
How do I have to adapt my code such that the rolling-mean lines are representative of my data?
Your issue is you are applying a moving average over the whole column, which makes data "leak" from one value of time to another.
You could group_by first to apply the rollmean to each time separately:
ggplot(df.tidy, aes(x = episode, y = value, col = time)) +
geom_point(alpha = 0.2) +
geom_line(data = df.tidy %>%
group_by(time) %>%
mutate(value = rollmean(value, 10, align = "right", fill = NA)))
I'd like to make a bar plot featuring an overlay of data from two time points, 'before' and 'after'.
At each time point, participants were asked two questions ('pain' and 'fear'), which they would answer by stating a score of 1, 2, or 3.
My existing code plots the counts for the data from the 'before' time point nicely, but I can't seem to add the counts for the 'after' data.
This is a sketch of what I'd like the plot to look like with the 'after' data added, with the black bars representing the 'after' data:
I'd like to make the plot in ggplot2() and I've tried to adapt code from How to superimpose bar plots in R? but I can't get it to work for grouped data.
Many thanks!
#DATA PREP
library(dplyr)
library(ggplot2)
library(tidyr)
df <- data.frame(before_fear=c(1,1,1,2,3),before_pain=c(2,2,1,3,1),after_fear=c(1,3,3,2,3),after_pain=c(1,1,2,3,1))
df <- df %>% gather("question", "answer_option") # Get the counts for each answer of each question
df2 <- df %>%
group_by(question,answer_option) %>%
summarise (n = n())
df2 <- as.data.frame(df2)
df3 <- df2 %>% mutate(time = factor(ifelse(grepl("before", question), "before", "after"),
c("before", "after"))) # change classes and split data into two data frames
df3$n <- as.numeric(df3$n)
df3$answer_option <- as.factor(df3$answer_option)
df3after <- df3[ which(df3$time=='after'), ]
df3before <- df3[ which(df3$time=='before'), ]
# CODE FOR 'BEFORE' DATA ONLY PLOT - WORKS
ggplot(df3before, aes(fill=answer_option, y=n, x=question)) + geom_bar(position="dodge", stat="identity")
# CODE FOR 'BEFORE' AND 'AFTER' DATA PLOT - DOESN'T WORK
ggplot(mapping = aes(x, y,fill)) +
geom_bar(data = data.frame(x = df3before$question, y = df3before$n, fill= df3before$index_value), width = 0.8, stat = 'identity') +
geom_bar(data = data.frame(x = df3after$question, y = df3after$n, fill=df3after$index_value), width = 0.4, stat = 'identity', fill = 'black') +
theme_classic() + scale_y_continuous(expand = c(0, 0))
I think the clue is to set the width of the "after" bars, but to dodge them as if their width are 0.9 (i.e. the same (default) width as the "before" bars). In addition, because we don't map fill of the "after" bars, we need to use the group aesthetic instead to achieve the dodging.
I prefer to have only one data set and just subset it in each call to geom_col.
ggplot(mapping = aes(x = question, y = n, fill = factor(ans))) +
geom_col(data = d[d$t == "before", ], position = "dodge") +
geom_col(data = d[d$t == "after", ], aes(group = ans),
fill = "black", width = 0.5, position = position_dodge(width = 0.9))
Data:
set.seed(2)
d <- data.frame(t = rep(c("before", "after"), each = 6),
question = rep(c("pain", "fear"), each = 3),
ans = 1:3, n = sample(12))
Alternative data preparation using data.table, starting with your original 'df':
library(data.table)
d <- melt(setDT(df), measure.vars = names(df), value.name = "ans")
d[ , c("t", "question") := tstrsplit(variable, "_")]
Either pre-calculate the counts and proceed as above with geom_col
# d2 <- d[ , .N, by = .(question, ans)]
Or let geom_bar do the counting:
ggplot(mapping = aes(x = question, fill = factor(ans))) +
geom_bar(data = d[d$t == "before", ], position = "dodge") +
geom_bar(data = d[d$t == "after", ], aes(group = ans),
fill = "black", width = 0.5, position = position_dodge(width = 0.9))
Data:
df <- data.frame(before_fear = c(1,1,1,2,3), before_pain = c(2,2,1,3,1),
after_fear = c(1,3,3,2,3),after_pain = c(1,1,2,3,1))
My solution is very similar to #Henrik's, but I wanted to point out a few things.
First, you're building your data frames inside your geom_cols, which is probably messier than you need it to be. If you've already created df3after, etc., you might as well use it inside your ggplot.
Second, I had a hard time following your tidying. I think there are a couple tidyr functions that might make this task easier on you, so I went a different route, such as using separate to create the columns of time and measure, rather than essentially searching for them manually, making it more scalable. This also lets you put "pain" and "fear" on your x-axis, rather than still having "before_pain" and "before_fear", which are no longer accurate representations once you have "after" values on the plot as well. But feel free to disregard this and stick with your own method.
library(tidyverse)
df <- data.frame(before_fear = c(1,1,1,2,3),
before_pain = c(2,2,1,3,1),
after_fear = c(1,3,3,2,3),
after_pain = c(1,1,2,3,1))
df_long <- df %>%
gather(key = question, value = answer_option) %>%
mutate(answer_option = as.factor(answer_option)) %>%
count(question, answer_option) %>%
separate(question, into = c("time", "measure"), sep = "_", remove = F)
df_long
#> # A tibble: 12 x 5
#> question time measure answer_option n
#> <chr> <chr> <chr> <fct> <int>
#> 1 after_fear after fear 1 1
#> 2 after_fear after fear 2 1
#> 3 after_fear after fear 3 3
#> 4 after_pain after pain 1 3
#> 5 after_pain after pain 2 1
#> 6 after_pain after pain 3 1
#> 7 before_fear before fear 1 3
#> 8 before_fear before fear 2 1
#> 9 before_fear before fear 3 1
#> 10 before_pain before pain 1 2
#> 11 before_pain before pain 2 2
#> 12 before_pain before pain 3 1
I split this into before & after datasets, as you did, then plotted them with 2 geom_cols. I still put df_long into ggplot, treating it almost as a dummy to get uniform x and y aesthetics. Like #Henrik said, you can use different width in the geom_col and in its position_dodge to dodge the bars at a width of 90% but give the bars themselves a width of only 40%.
df_before <- df_long %>% filter(time == "before")
df_after <- df_long %>% filter(time == "after")
ggplot(df_long, aes(x = measure, y = n)) +
geom_col(aes(fill = answer_option),
data = df_before, width = 0.9,
position = position_dodge(width = 0.9)) +
geom_col(aes(group = answer_option),
data = df_after, fill = "black", width = 0.4,
position = position_dodge(width = 0.9))
What you could instead of making the two separate data frames is to filter inside each geom_col. This is generally my preference unless the filtering is more complex. This code will get the same plot as above.
ggplot(df_long, aes(x = measure, y = n)) +
geom_col(aes(fill = answer_option),
data = . %>% filter(time == "before"), width = 0.9,
position = position_dodge(width = 0.9)) +
geom_col(aes(group = answer_option),
data = . %>% filter(time == "after"), fill = "black", width = 0.4,
position = position_dodge(width = 0.9))