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))
Related
I am trying to use different fill for geom_ribbon according to the x-values (For Temp = 0-20 one fill, 20-30.1 another fill and > 30.1 another fill). I am using the following code
library(tidyverse)
bounds2 <- df %>%
mutate(ymax = pmax(Growth.rate, slope),
ymin = pmin(Growth.rate, slope),
x_bins = cut(Temp, breaks = c(0,20,30.1,max(Temp)+5)))
ggplot(df, aes(x = Temp, y = Growth.rate)) +
geom_line(colour = "blue") +
geom_line(aes(y = slope), colour = "red") +
scale_y_continuous(sec.axis = sec_axis(~ .^1, name = "slope")) +
geom_ribbon(data = bounds2, aes(Temp, ymin = ymin, ymax = ymax, fill = x_bins),
alpha = 0.4)
It is returning me following output
As you can see from the output some regions are remaining empty. Now how can I fill those parts in the curve?
Here is the data
df = structure(list(Temp = c(10, 13, 17, 20, 25, 28, 30, 32, 35, 38
), Growth.rate = c(0, 0.02, 0.19, 0.39, 0.79, 0.96, 1, 0.95,
0.65, 0), slope = c(0, 0.02, 0.16, 0.2, 0.39, 0.1, 0.03, -0.04,
-0.29, -0.65)), row.names = c(NA, 10L), class = "data.frame")
Here's a solution that involves interpolating new points at the boundaries between the areas. I used approx to get the values of ymin and ymax at Temp=30.1 and added this to the plotting dataset.
Then, instead of using cut just once as you did I use it twice, once with lower bounds included in each set then once with upper bounds included. Then I reshape the data long, and de-duplicate the rows I don't need.
If you zoom in enough you can see that the boundary is at 30.1 not at 30.
bounds2 <- df %>%
mutate(ymax = pmax(Growth.rate, slope),
ymin = pmin(Growth.rate, slope))
bounds2 <- bounds2 |>
add_case(Temp=30.1,
ymax=approx(bounds2$Temp,bounds2$ymax,xout = 30.1)$y,
ymin=approx(bounds2$Temp,bounds2$ymin,xout = 30.1)$y) |>
mutate(x_bins2 = cut(Temp, breaks = c(0,20,30.1,max(Temp)+5),right=FALSE, labels=c("0-20","20-30.1","30.1-max")),
x_bins = cut(Temp, breaks = c(0,20,30.1,max(Temp)+5), labels=c("0-20","20-30.1","30.1-max"))) |>
tidyr::pivot_longer(cols=c(x_bins2, x_bins), names_to = NULL, values_to = "xb") |>
distinct()
ggplot(df, aes(x = Temp, y = Growth.rate)) +
geom_line(colour = "blue") +
geom_line(aes(y = slope), colour = "red") +
scale_y_continuous(sec.axis = sec_axis(~ .^1, name = "slope")) +
geom_ribbon(data = bounds2, aes(Temp, ymin = ymin, ymax = ymax, fill = xb),
alpha = 0.4)
The idea is here but the code I show can be much improved at the step ### Dupplicate the 2 last x_bins from each category and move them into the next
### Libraries
library(tidyverse)
df <- structure(list(Temp = c(10, 13, 17, 20, 25, 28, 30, 32, 35, 38
), Growth.rate = c(0, 0.02, 0.19, 0.39, 0.79, 0.96, 1, 0.95,
0.65, 0), slope = c(0, 0.02, 0.16, 0.2, 0.39, 0.1, 0.03, -0.04,
-0.29, -0.65)), row.names = c(NA, 10L), class = "data.frame")
### Preprocessing
bounds2 <- df %>%
mutate(ymax = pmax(Growth.rate, slope),
ymin = pmin(Growth.rate, slope),
x_bins = cut(Temp, breaks = c(0, 20, 30.1, max(Temp)+5)))
### Dupplicate the 2 last x_bins from each category and move them into the next category
bounds2 <- rbind(bounds2, bounds2[c(4, 7), ])
bounds2$x_bins[c(11, 12)] <- bounds2[c(5, 8), ]$x_bins
### Plot
ggplot(df, aes(x = Temp, y = Growth.rate)) +
geom_line(colour = "blue") +
geom_line(aes(y = slope), colour = "red") +
scale_y_continuous(sec.axis = sec_axis(~ .^1, name = "slope")) +
geom_ribbon(data = bounds2, aes(Temp, ymin = ymin, ymax = ymax, fill = x_bins),
alpha = 0.4)
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())
I have data and I need to reproduce a graph like this. I'm not sure what this type of plot is called, thus I also don't know how to plot it in R. Any help is appreciated.
I don't know what it's called, but here's a function to produce one:
library(ggplot2)
quadrant_plot <- function(component, values,
fills = c("#919191", "#686868", "#434343", "#ededed"))
{
df <- data.frame(component = factor(component, levels = component),
xvalue = c(values[1:2], -values[3:4]),
yvalue = c(values[1], -values[2:3], values[4]),
xmin = c(0, 0, -Inf, -Inf),
xmax = c(Inf, Inf, 0, 0),
ymin = c(0, -Inf, -Inf, 0),
ymax = c(Inf, 0, 0, Inf),
textx = c(50, 50, -50, -50),
texty = c(50, -50, -50, 50),
labelx = c(95, 95, -95, -95),
labely = c(95, -95, -95, 95),
hjust = c(1, 1, 0, 0))
ggplot(df, aes(xvalue, yvalue)) +
geom_rect(aes(xmin = xmin, xmax = xmax,
ymin = ymin, ymax = ymax, fill = component)) +
geom_point() +
geom_polygon(fill = NA, color = "black", size = 1) +
geom_text(aes(x = textx, y = texty, label = abs(xvalue))) +
geom_text(aes(x = labelx, y = labely, label = component, hjust = hjust),
size = 6) +
geom_hline(aes(yintercept = 0), size = 1) +
geom_vline(aes(xintercept = 0), size = 1) +
scale_fill_manual(values = fills, guide = guide_none()) +
lims(x = c(-100, 100), y = c(-100, 100)) +
coord_equal() +
theme_void()
}
So you can do:
quadrant_plot(component = c("Adhocracy", "Hierarchy", "Market", "Clan"),
values = c(18.4, 22.9, 32.6, 26.5))
Or if you want to change the input and the colours you can do
quadrant_plot(component = c("Optimism", "Insight", "Skill", "Luck"),
values = c(35, 15, 12, 31),
fills = c("gold", "deepskyblue4", "orange", "lightblue"))
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!
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"))