I am trying to output an animation using R and gganimate. I want an animation of 3 columns and 10 rows, each cell of which is lighted up one by one to show all row combinations. I think the code and animation below explain it.
library(data.table)
library(ggplot2)
library(gganimate)
library(magrittr)
scn_to_plot <- 1000
lst_block <- lapply(seq(10), function(i) {
return(c(list(rep(0:2, each = 3**(10-i), times = 3**(i-1))), list(rep(1:3, each = 3**(10-i), times = 3**(i-1)))))
}) %>% do.call(c, .) %>% set_names(paste0(rep(paste0("p", 1:10), each = 2), rep(c("x1", "x2"), times = 10))) %>% as.data.table
lst_block[lst_block == 1] <- 1/3
lst_block[lst_block == 2] <- 2/3
lst_block[lst_block == 3] <- 1
lst_block[, paste0(rep(paste0("p", 1:10), each = 2), rep(c("y1", "y2"), times = 10)) := list(
0.9, 1, 0.8, 0.9, 0.7, 0.8, 0.6, 0.7, 0.5, 0.6, 0.4, 0.5, 0.3, 0.4, 0.2, 0.3, 0.1, 0.2, 0, 0.1
)]
lst_block[, scnN := seq(.N)]
p_bs <- ggplot(lst_block[1:scn_to_plot], aes(x = p1x1, y = p1y1)) +
coord_cartesian(xlim = c(0, 1), ylim = c(0, 1)) +
theme_classic() +
theme(axis.line = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank(),
plot.margin = margin(0, 0, 0, 0, "cm"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
p_bs %<>%
add(geom_rect(aes(xmin = p1x1, xmax = p1x2, ymin = p1y1, ymax = p1y2), size = 0, fill = "#ff0000", alpha = 0.25)) %>%
add(geom_rect(aes(xmin = p2x1, xmax = p2x2, ymin = p2y1, ymax = p2y2), size = 0, fill = "#ff0000", alpha = 0.25)) %>%
add(geom_rect(aes(xmin = p3x1, xmax = p3x2, ymin = p3y1, ymax = p3y2), size = 0, fill = "#ff0000", alpha = 0.25)) %>%
add(geom_rect(aes(xmin = p4x1, xmax = p4x2, ymin = p4y1, ymax = p4y2), size = 0, fill = "#ff0000", alpha = 0.25)) %>%
add(geom_rect(aes(xmin = p5x1, xmax = p5x2, ymin = p5y1, ymax = p5y2), size = 0, fill = "#ff0000", alpha = 0.25)) %>%
add(geom_rect(aes(xmin = p6x1, xmax = p6x2, ymin = p6y1, ymax = p6y2), size = 0, fill = "#ff0000", alpha = 0.25)) %>%
add(geom_rect(aes(xmin = p7x1, xmax = p7x2, ymin = p7y1, ymax = p7y2), size = 0, fill = "#ff0000", alpha = 0.25)) %>%
add(geom_rect(aes(xmin = p8x1, xmax = p8x2, ymin = p8y1, ymax = p8y2), size = 0, fill = "#ff0000", alpha = 0.25)) %>%
add(geom_rect(aes(xmin = p9x1, xmax = p9x2, ymin = p9y1, ymax = p9y2), size = 0, fill = "#ff0000", alpha = 0.25)) %>%
add(geom_rect(aes(xmin = p10x1, xmax = p10x2, ymin = p10y1, ymax = p10y2), size = 0, fill = "#ff0000", alpha = 0.25))
p_bs %<>% add(transition_manual(scnN))
anim_save("plot_combn.gif", animation = p_bs, nframes = 600, fps = 60, bg = "transparent")
I am encountering two problems:
No matter how I change the fps (the last line) (I also tried using options(gganimate.fps = xx), it seems that the fps of the final output gif file is fixed at somewhere like 10.
The background cannot be changed to transparent even I have specified it for the png device. (I need to embed the resultant gif file in powerpoint presentation, but the outcome always has a white background.)
Any help is appreciated.
It seems like the maximum allowed fps value is 50. If you go above that (like in your case 60) it will go back to the default 10 without any error messages. So try set the fps to 50!
Related
I want to show covered ranges (including overlaps) and (after some failures with stacked bar plots) I chose geom_rect. The following code works well for one type.
library(tidyverse)
# create dummy data
foo <- tibble(start = c(1, 150, 140, 75, 300),
end = c(150, 180, 170, 160, 400))
ggplot() +
geom_rect(data = foo, aes(xmin = start, xmax = end, ymin = 0, ymax = 1), fill = "green", linetype = "blank", alpha = 0.3) +
geom_rect(data = foo, aes(xmin = 1, xmax = max(end), ymin = 0, ymax = 1), fill = NA, colour = "black") +
scale_y_continuous(name = "", breaks = NULL, limits = c(0, 1)) +
scale_x_continuous(name = "", breaks = NULL) +
theme_minimal() +
theme(panel.grid = element_blank())
If I add more data (only one more type, but in the original data I do have some more) like below, I can add the data "by hand", i.e. add two lines of code for each type, but I'm looking for a way to do this by grouping, but didn't succeed.
foo <- foo %>%
mutate(type = "A", .before = 1)
bar <- tibble(type = "B",
start = c(1, 30, 40, 100, 150, 200, 310),
end = c(20, 50, 100, 120, 200, 300, 380))
foo <- bind_rows(foo, bar)
ggplot() +
geom_rect(data = foo %>% filter(type == "A"), aes(xmin = start, xmax = end, ymin = 0, ymax = 1), fill = "green", linetype = "blank", alpha = 0.3) +
geom_rect(data = foo, aes(xmin = 1, xmax = max(end), ymin = 0, ymax = 1), fill = NA, colour = "black") +
geom_rect(data = foo %>% filter(type == "B"), aes(xmin = start, xmax = end, ymin = 2, ymax = 3), fill = "green", linetype = "blank", alpha = 0.3) +
geom_rect(data = foo, aes(xmin = 1, xmax = max(end), ymin = 2, ymax = 3), fill = NA, colour = "black") +
scale_y_continuous(name = "", breaks = NULL, limits = c(0, 3)) +
scale_x_continuous(name = "", breaks = NULL) +
geom_text(aes(x = c(0, 0), y = c(0.5, 2.5), label = c("A", "B")), size = 4, hjust = 2) +
theme_minimal() +
theme(panel.grid = element_blank())
So, the graph already looks the way I want, but I'd prefer to get here by using grouping (or any other non-manual way).
Maybe there's also a different geom or method to get this kind of graph?
You can write a small helper function that positions a categorical value in continuous space. Example below.
helper <- function(x) {(match(x, sort(unique(x))) - 1) * 2}
ggplot(foo) +
geom_rect(
aes(xmin = start, xmax = end,
ymin = helper(type),
ymax = helper(type) + 1),
fill = "green", linetype = "blank", alpha = 0.3
) +
geom_rect(
aes(xmin = min(start), xmax = max(end),
ymin = helper(type),
ymax = helper(type) + 1),
fill = NA, colour = "black"
) +
scale_y_continuous(name = "", breaks = NULL, limits = c(0, 3)) +
scale_x_continuous(name = "", breaks = NULL) +
annotate(
"text", x = c(0, 0), y = c(0.5, 2.5), label = c("A", "B"),
size = 4, hjust = 2
) +
theme_minimal() +
theme(panel.grid = element_blank())
How to remove border from quadrant lines in geom_point plot (ggplot2) after adding "size"?
ggplot(
DurablesSIZE,
aes(
x = DurablesSIZE$`GDP LQ`,
y = DurablesSIZE$Slope,
color = DurablesSIZE$Sector,
size = DurablesSIZE$`2019 GDP`
)
) +
geom_point() +
geom_hline(yintercept = 0) +
geom_vline(xintercept = 1) +
xlim(0, 5.5) +
ylim(-0.26, 0.26) +
geom_rect(aes(
xmin = 1,
xmax = Inf,
ymin = 0,
ymax = Inf
),
fill = "green",
alpha = 0.03) +
geom_rect(aes(
xmin = -Inf,
xmax = 1,
ymin = -Inf,
ymax = 0
),
fill = "red",
alpha = 0.03) +
geom_rect(aes(
xmin = -Inf,
xmax = 1,
ymin = 0,
ymax = Inf
),
fill = "yellow",
alpha = 0.03) +
geom_rect(aes(
xmin = 1,
xmax = Inf,
ymin = -Inf,
ymax = 0
),
fill = "yellow",
alpha = 0.03) +
labs(y = "Slope of GDP LQ (5Y)",
x = "2019 GDP LQ",
color = "Sector",
size = "2019 GDP") +
ggtitle("Oregon Durable Manufacturing \nTargeting Potential (GDP)") +
geom_text(
aes(label = ifelse(Slope > 0 & LQ > 1, as.character(Sector), '')),
hjust = 0,
vjust = 0,
size = 2.5,
nudge_x = -0.07,
nudge_y = 0.013
) +
theme(legend.key = element_rect(colour = NA, fill = NA),
legend.box.background = element_blank())
After adding size to my points, there is a weird border around the quadrant line weird border.
The size aesthetic is being applied globally, so it is creating a thick border around each geom_rect -- it controls border width for that geom.
To remove it, take size out of the global aes mapping and use geom_point(aes(size = '2019 GDP')) + to apply it to that layer alone.
Another note: if you use geom_rect for annotation purposes, it will be plotted once for each relevant line of your data, leading to massive overplotting and minimal control of alpha. It will be better to use annotate("rect" ...) for those, or to create a separate summary table which those layers can refer to so they only plot once.
Here's some fake data I made up so that I could run your code. Please include something like this in your questions.
DurablesSIZE <- tibble(
`GDP LQ` = 0.5*(1:10),
LQ = 10:1,
Slope = 0.05*(-4:5),
Sector = rep(LETTERS[1:5], 2),
`2019 GDP` = 1:10
)
Result with original code:
Revision with size aesthetic only applied locally:
I have a ggplot where I would like to have a striped background of grey and white. I have achieved this using geom_rect, as can be seen below:
ggplot(growth.mon, aes(x = Month, y = Rate)) +
geom_rect(ymin = 0.3, ymax = 0.4,
xmin = 0, xmax = 1000000, fill = '#fbfcfc') +
geom_rect(ymin = 0.2, ymax = 0.3,
xmin = 0, xmax = 1000000, fill = '#f5f6f9')+
geom_rect(ymin = 0.1, ymax = 0.2,
xmin = 0, xmax = 1000000, fill = '#fbfcfc')+
geom_rect(ymin = 0, ymax = 0.1,
xmin = 0, xmax = 1000000, fill = '#f5f6f9')+
geom_rect(ymin = -0.1, ymax = 0,
xmin = 0, xmax = 1000000, fill = '#fbfcfc')+
geom_rect(ymin = -0.2, ymax = -0.1,
xmin = 0, xmax = 1000000, fill = '#f5f6f9')+
geom_rect(ymin = -0.3, ymax = -0.2,
xmin = 0, xmax = 1000000, fill = '#fbfcfc')+
geom_bar(stat = "identity", aes(fill = as.factor(1)), show.legend = FALSE)+
geom_line(aes(y = rollMean, colour = "#7f5ba2"), size = 1.1, show.legend = FALSE)+
scale_fill_manual(values = c("#0095db"))+
scale_colour_manual(values = c("#7f5ba2"))+
scale_y_continuous(NULL, labels = percent_format())+
scale_x_date(date_breaks = "1 month", date_labels = "%b %Y")+
theme(axis.text.x=element_text(angle=60, hjust=1))+
theme(legend.position = "none")
This creates this:
Now I am developing a shiny app and I would like this plot to be interactive rather than static, so I use ggplotly like so:
ggplotly(gg_growth)
However, the chart ends up removing the bars like this:
Can someone tell me what went wrong and how to fix this, please? Thank you.
Data:
dates <- seq(as.Date("2017-02-01"), length = 36, by = "1 month") - 1
sales_mon17 <- c(1503, 1563, 1434.5,1807, 1843.7, 1664, 1285, 1188, 1513, 1997,1718.2, 2191)
sales_mon18 <- c(1919, 1886, 1995, 1930, 1898, 2122, 1818, 1908, 1974, 2074, 1700, 2303)
sales_mon19 <- c(2319, 2424, 2353, 2474, 2500, 2538, 2444, 2219, 1908, 2404, 2288, 3079.7)
monthly_revenue <- data.frame(Month = dates, Revenue = c(sales_mon17, sales_mon18, sales_mon19))
growth.mon <- diff(monthly_revenue$Revenue) / lag(monthly_revenue$Revenue)[-1]
growth.mon <- data.frame(Month = monthly_revenue$Month[-1], Rate = growth.mon)
growth.mon$rollMean <- c(NA, NA, rollmean(growth.mon$Rate, 3))
I have a dataframe like this one:
value = runif(n = 1000)
type = rep(c("a","b","c","d"),250)
type2 = rep(c("a","b"),500)
number = sample(1:4, 1000, replace=TRUE, prob=c(0.25, 0.25, 0.25, 0.25) )
feature = c(rep("small",500),rep("big",500))
allResults <- data.frame(value,type,type2,number,feature)
I'd like to color the background of boxplot by type2 value. If i use fill and col, it's not very clear. I think is more intutitive the background color if is possible.
library("ggplot2")
ggplot(allResults, aes(y=value, x=type)) + geom_boxplot(alpha=.3, aes(fill = type,col=type2)) +
ggtitle("comparison") + facet_grid(feature ~ number) +
theme(legend.position = "bottom",axis.text.x = element_text(angle = 90, hjust = 1)) +
scale_y_continuous(breaks = seq(0, 1, by = 0.05),limits = c(0,1))
This is my result at the moment:
I have seen that is possible to color the backgroud using geom_rect() but I don't understand how to apply.
You could use geom_rect and set your divisions. I originally had a and b as your rects factors, but to match colors in your type fill just set them to a and c.
value = runif(n = 1000)
type = rep(c("a","b","c","d"),250)
type2 = rep(c("a","b"),500)
number = sample(1:4, 1000, replace=TRUE, prob=c(0.25, 0.25, 0.25, 0.25) )
feature = c(rep("small",500),rep("big",500))
nFac <- 4 # define number of factors (types) here
rects <- data.frame(xmin = head(seq <- seq(0.5, nFac + .5, 1), -1),
xmax = tail(seq, -1), rect_type = c("a", "c")) #set your divisions here
allResults <- data.frame(value,type,type2,number,feature, rects)
ggplot(allResults, aes(y=value, x=type)) + geom_boxplot(aes(fill = type, col=type2)) +
geom_rect(aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf, fill = rect_type), alpha = 0.009) +
ggtitle("comparison") + facet_grid(feature ~ number) +
theme(legend.position = "bottom",axis.text.x = element_text(angle = 90, hjust = 1)) +
scale_y_continuous(breaks = seq(0, 1, by = 0.05),limits = c(0,1))
I am trying to recreate the waterfall chart as shown in
https://vita.had.co.nz/papers/ggplot2-wires.pdf
I am reproducing the code from the link
balance <- data.frame(event = c("Starting\nCash", "Sales", "Refunds",
"Payouts", "Court\nLosses", "Court\nWins", "Contracts", "End\nCash"),
change = c(2000, 3400, -1100, -100, -6600, 3800, 1400, -2800))
balance$balance <- cumsum(c(0, balance$change[-nrow(balance)]))
balance$time <- 1:nrow(balance)
balance$flow <- factor(sign(balance$change))
ggplot(balance) +
geom_hline(yintercept = 0, colour = "white", size = 2) +
geom_rect(aes(fill= 'red'),xmin = time - 0.45, xmax = time + 0.45, ymin = balance, ymax = balance)
geom_text(aes(x = time, y = pmin(balance, balance + change) - 50, label = dollar(change)),
hjust = 0.5, vjust = 1, size = 3)
scale_x_continuous( breaks = balance$time, labels = balance$event) +
scale_y_continuous("Balance") +
scale_fill_manual(values = c("-1" = "red", "1" = "black"))
it throws an error :Error in scale_x_continuous(breaks = balance$time, labels = balance$event) + : non-numeric argument to binary operator
THe final output, per the pdf should look like the image below
ggplot(balance %>%
mutate(flow = factor(flow, labels = c("Negative", "Positive")))) +
geom_hline(yintercept = 0, colour = "white", size = 2) +
geom_rect(aes(fill= flow, xmin = time - 0.45, xmax = time+0.45, ymin = change, ymax = balance),
color = "black") +
geom_text(aes(x = time, y = pmin(balance, balance + change) - 50, label = change),
hjust = 0.5, vjust = 1, size = 3) +
scale_x_continuous(breaks = balance$time, labels = balance$event) +
scale_y_continuous("Balance") +
scale_fill_manual(values = c("Negative" = "red", "Positive" = "green"))