In R, using gganimate, one can make an animated plot where events appear and disappear with time. For example:
library(lubridate)
library(gganimate)
df=data.frame(
x=c(1,2,3,4),
y=c(1,2,3,4),
start=c(1,2,3,4),
end=c(5,6,7,8),
en=as_date(1),
ex=as_date(1))
ggplot(data=df, aes(x=x,y=y))+
geom_point()+
gganimate::transition_events(
start=start,
end=end,
enter_length = as.numeric(en),
exit_length = as.numeric(ex))
This produces a plot in which points appear according to column "start" and desappear according to column "end".
I wonder if there is an easy way to achieve the same in with plotly (preferably using ggplotly()), getting a slider to move along the time.
Here is an example using ggplotly. The result however isn't exactly the same:
library(plotly)
library(lubridate)
df = data.frame(
x = c(1, 2, 3, 4),
y = c(1, 2, 3, 4),
start = c(1, 2, 3, 4),
end = c(5, 6, 7, 8),
en = as_date(1),
ex = as_date(1)
)
frame_list <- Map(seq, from = df$start, to = df$end)
DF <- data.frame(x = rep(df$x, times = lengths(frame_list)),
y = rep(df$y, times = lengths(frame_list)),
frame = unlist(frame_list))
p <- ggplot(DF, aes(x, y)) +
geom_point(aes(size = y, frame = frame))
fig <- ggplotly(p)
fig %>%
animation_opts(
frame = 0,
easing = "linear",
redraw = FALSE,
mode = "immediate"
)
fig
Related
I want to automate adding brackets/braces to a ggplot object and then convert it to plotly using ggplotly.
library(tidyverse)
library(plotly)
#devtools::install_github("NicolasH2/ggbrace")
library(ggbrace)
set.seed(10)
mydata <- data.frame(xx = c(1:10), yy = sample(0:10, 10))
my_bracket_data <- data.frame(start = c(1, 4, 6),
end = c(3, 5, 9),
info = c("first", "second", "third"),
y_bottom = rep(11, 3),
y_top = rep(12, 3))
I can do this by using geom_brace but it involves manually typing it out for each brace rather than using the data that is already stored in a data.frame:
plot_geom_brace <- ggplot(data = mydata, aes(xx, yy)) +
geom_line(size = 1.5) +
geom_brace(aes(x = c(1, 3), y = c(11, 12), label = "first"), inherit.data = F, labelsize = 5) +
geom_brace(aes(x = c(4, 5), y = c(11, 12), label = "second"), inherit.data = F, labelsize = 5) +
geom_brace(aes(x = c(6, 9), y = c(11, 12), label = "third"), inherit.data = F, labelsize = 5)
plot_geom_brace
ggplotly(plot_geom_brace)
Is there a way that I can do this without repeatedly writing geom_brace layers for each brace (and instead access the data from my_bracket_data directly)?
As an aside this can be automated using geom_bracket but this is not supported by plotly yet.
library(ggpubr)
plot_geom_bracket <- ggplot(data = mydata, aes(xx, yy)) +
geom_line(size = 1.5) +
geom_bracket(xmin = my_bracket_data$start,
xmax = my_bracket_data$end,
y.position = rep(11, 3),
label = my_bracket_data$info,
inherit.aes = FALSE)
plot_geom_bracket
ggplotly(plot_geom_bracket)
# Warning message:
# In geom2trace.default(dots[[1L]][[1L]], dots[[2L]][[1L]], dots[[3L]][[1L]]) :
# geom_GeomBracket() has yet to be implemented in plotly.
# If you'd like to see this geom implemented,
# Please open an issue with your example code at
# https://github.com/ropensci/plotly/issues
Any suggestions?
Thanks
An option could be by creating two dataframes of your bracket data. One dataframe for the geom_braces by converting the data to a longer format with pivot_longer to create three geom braces through the aes. To get the labels you can create a small summarise table with the x and y positions per group of info. Here is some reproducible code:
library(tidyverse)
library(plotly)
#devtools::install_github("NicolasH2/ggbrace")
library(ggbrace)
set.seed(10)
mydata <- data.frame(xx = c(1:10), yy = sample(0:10, 10))
my_bracket_data <- data.frame(start = c(1, 4, 6),
end = c(3, 5, 9),
info = c("first", "second", "third"),
y_bottom = rep(11, 3),
y_top = rep(12, 3))
# Data for geom_brace
my_bracket_data_long <- my_bracket_data %>%
pivot_longer(cols = c(start, end), values_to = "x_value", names_to = "x_names") %>%
pivot_longer(cols = c(y_bottom, y_top), values_to = "y_value", names_to = "y_names")
# data for labels braces
my_bracket_data_labels <- my_bracket_data_long %>%
group_by(info) %>%
summarise(x_pos = mean(x_value),
y_pos = mean(y_value) + 1)
# plot
plot_geom_brace <- ggplot(data = mydata, aes(xx, yy)) +
geom_line(size = 1.5) +
geom_brace(data = my_bracket_data_long, aes(x = x_value, y = y_value, group = info)) +
geom_text(data = my_bracket_data_labels, aes(x = x_pos, y = y_pos, group = info, label = info))
ggplotly(plot_geom_brace)
Created on 2023-01-07 with reprex v2.0.2
special ggplot2 libraries like ggpubr usually don't play along well with conversion to plotly objects.
If you dont want to type out each geom_bracet call you could loop over the rows of the dataframe, create the geom statement using paste and pass it to the existing plot object using eval in the following line:
m<- data.frame(s = c(1, 4, 6), ## = my_bracket_data
e = c(3, 5, 9),
i = c("first", "second", "third"),
y_b = rep(11, 3),
y_t = rep(12, 3))
p<- ggplot(data = mydata, aes(xx, yy)) + geom_line(size = 1.5)
for (i in 1:NROW(my_bracket_data)) {
input = paste('geom_brace(aes(x =c(',m[i,]$s,',',m[i,]$e'),c(',m[i,]$y_b,',',
m[i,]$y_t,'),label=',m[i,]$i,'), inherit.data = F, labelsize = 5)',sep='')
p = p + eval(parse(text=input))
}
p
However this is more of a hacky solution, but that's what R tends to become if you incorporate/mix different styles like for example apply functions with tidyr syntax (or in this case ggplot, which could be seen as an ancestor of tidyr) and more programming style approaches (for, while , func...[yes you can programm in R]) and also want to let it automatically converse the whole thing to a Javascript thing (aka plotly) . .. its a beautiful mess .
I would like to link variables I have in a dataframe i.e. ('prop1', 'prop2', 'prop3') to specific colours and shapes in the plot. However, I also want to exclude data (using dplyr::filter) to customise the plot display WITHOUT changing the points and shapes used for a specific variable. A minimal example is given below.
library(ggplot2)
library(dplyr)
library(magrittr)
obj <- c("cmpd 1","cmpd 1","cmpd 1","cmpd 2","cmpd 2")
x <- c(1, 2, 4, 7, 3)
var <- c("prop1","prop2","prop3","prop2","prop3")
y <- c(1, 2, 3, 2.5, 4)
col <- c("#E69F00","#9E0142","#56B4E9","#9E0142","#56B4E9")
shp <- c(0,1,2,1,2)
df2 <- cbind.data.frame(obj,x,var,y,col,shp)
plot <- ggplot(data = df2 %>%
filter(obj %in% c(
"cmpd 1",
"cmpd 2"
)),
aes(x = x,
y = y,
colour = as.factor(var),
shape = as.factor(var))) +
geom_point(size=2) +
#scale_shape_manual(values=shp) +
#scale_color_manual(values=col) +
facet_grid(.~obj)
plot
However, when I redact cmpd1 (just hashing in code) the colour and shape of prop2 and prop3 for cmpd2 change (please see plot2).
To this end, I tried adding in scale_shape_manual and scale_color_manual to the code (currently hashed) and linked these to specific vars (col and shp) in the dataframe (df2), but the same problem arises that both the shape and color of these variables changes when excluding one of the conditions?
Any and all help appreciated.
Try something like this:
library(tidyverse)
obj <- c("cmpd 1","cmpd 1","cmpd 1","cmpd 2","cmpd 2")
x <- c(1, 2, 4, 7, 3)
var <- c("prop1","prop2","prop3","prop2","prop3")
y <- c(1, 2, 3, 2.5, 4)
df2 <- cbind.data.frame(obj,x,var,y)
col <- c("prop1" = "#E69F00",
"prop2" = "#9E0142",
"prop3" = "#56B4E9")
shp <- c("prop1" = 0,
"prop2" = 1,
"prop3" = 2)
plot <- ggplot(data = df2 %>%
filter(obj %in% c(
"cmpd 1",
"cmpd 2"
)),
aes(x = x,
y = y,
colour = var,
shape = var)) +
geom_point(size=2) +
scale_shape_manual(values=shp) +
scale_color_manual(values=col) +
facet_grid(.~obj)
plot
I try to make a bubble chart with ggplot/ggimage by including the country flag. Here is a reproducible example:
library(dplyr)
library(ggplot)
library(ggimage)
A <- data.frame(X = c(1,4,5), Y = c(10, 1, 5), Z = c(1, 2, 3)/30, Country = c("FR", "BE", "IT"), CountryFlag = paste0("https://flagcdn.com/h20/", str_to_lower(Country), ".png"))
A_plot <- ggplot(A, mapping = aes(x = X, y = Y, size = I(Z), image = CountryFlag)) +
geom_image()
X11(); print(A_plot)
Except downloading the rounded flags, is that possible to transform the flag as rounded or is it possible to insert the country in a bubble. I tried the following code but it doesn't work:
library(dplyr)
library(ggplot)
library(ggimage)
A <- data.frame(X = c(1,4,5), Y = c(10, 1, 5), Z = c(1, 2, 3), Country = c("FR", "BE", "IT"), CountryFlag = paste0("https://flagcdn.com/h20/", str_to_lower(Country), ".png"))
A_plot <- ggplot(A, mapping = aes(x = X, y = Y, size = Z, image = CountryFlag)) +
geom_point(alpha = 0.5, col = "lightblue") +
geom_image()
X11(); print(A_plot)
I get the error:
Error in `[<-`(`*tmp*`, !is.na(alpha), 4, value = alpha[!is.na(alpha)]) :
(subscript) logical subscript too long
In addition: Warning message:
In rep(colour, length.out = length(alpha)) :
'x' is NULL so the result will be NULL
Any suggestion is welcome.
Here's a function that adds a circular mask to each flag. If we start with your plot,
A_plot
We get the urls and create some local filenames:
flags <- A_plot$data$CountryFlag
png_files <- sapply(strsplit(flags, "/"), function(x) x[length(x)])
Now we create some images with a circular mask and save them locally:
OK <- Map(function(flag, png) {
im <- magick::image_read(flag)
im <- magick::image_resize(im, magick::geometry_size_percent(500, 2000))
ii <- magick::image_info(im)
width <- ii$width
fig <- magick::image_draw(magick::image_blank(height, height))
symbols(width/2, width/2, circles=(width/2), bg='black', inches=FALSE, add=TRUE)
im2 <- magick::image_composite(im, fig, operator='copyopacity')
magick::image_write(im2, png)
}, flag = flags, png = png_files)
Now write these file paths as our image locations in the plot object:
A_plot$data$CountryFlag <- png_files
Which changes our plot to:
A_plot
For completeness, we should tidy up after ourselves once the plot is drawn:
sapply(png_files, unlink)
Funnily enough, someone just asked a question which pointed to a package for an easy way to get exactly what you want. The {ggflags} package (not on CRAN!) introduces geom_flag, which uses readily available round flag icons from the EmojiOne set as points.
library(tidyverse)
# devtools::install_github("jimjam-slam/ggflags")
library(ggflags)
Country <- c("FR", "BE", "IT")
A <- data.frame(
X = c(1, 4, 5), Y = c(10, 1, 5), Z = c(1, 2, 3), Country = tolower(Country))
ggplot(A, mapping = aes(x = X, y = Y, size = Z*3, country = Country)) +
geom_flag()+
# you can then set the scale as usual by using scale_size
scale_size_identity(guide = guide_legend())
Created on 2022-04-03 by the reprex package (v2.0.1)
I want to create a timeline plot that roughly resembles the example below: lots of overlap at some points, not a lot of overlap at others.
What I need: overlapping images should repel each other where necessary, eliminating or reducing overlap. Ideally I'd be able to implement either a vertical or horizontal repel.
library(tidyverse)
library(ggimage)
test_img <- list.files(system.file("extdata", package="ggimage"), pattern="png", full.names=TRUE)
set.seed(123)
df <-
tibble(date = as.Date(paste0("2020-", round(runif(45, 1, 2)), "-", round(runif(45, 1, 10)))),
group = paste0("Timeline ", rep(1:9, each = 5)),
img = sample(test_img, size = 45, replace = T) )
df %>%
ggplot() +
geom_line(aes(x = date, y = group, group = group), size = 5, alpha = 0.2) +
geom_image(aes(x = date, y = group, image = img, group = group), asp = 1)
Something similar to the repelling in ggbeeswarm::geom_beeswarm or ggrepel::geom_text_repel would be nice, but those don't support images. So I think I need to pre-apply some kind of 1-dimensional packing algorithm, implementing iterative pair-wise repulsion on my vector of dates within each group, to try to find a non-overlapping arrangement.
Any ideas? Thank you so much!
Created on 2021-10-30 by the reprex package (v2.0.1)
Here is the solution I’ve been able to come up with, repurposing the circleRepelLayout function from the awesome packcircles package
into the repel_vector vector function that takes in your overlapping vector and a "repel_radius", and returns, if possible, a non-overlapping version.
I demonstrate the solution with the richtext geom since this is a geom I’ve always wished had repel functionality.
library(packcircles)
library(tidyverse)
library(ggtext)
library(ggimage)
repel_vector <- function(vector, repel_radius = 1, repel_bounds = range(vector)){
stopifnot(is.numeric(vector))
repelled_vector <-
packcircles::circleRepelLayout(x = data.frame(vector, ypos = 1, repel_radius),
xysizecols = c("vector", "ypos", "repel_radius"),
xlim = repel_bounds, ylim = c(0,1),
wrap = FALSE) %>%
as.data.frame() %>%
.$layout.x
return(repelled_vector)
}
overlapping_vec <- c(1, 1.1, 1.2, 10, 10.1, 10.2)
repelled_vec_default <- repel_vector(overlapping_vec)
repelled_vec_tighter <- repel_vector(overlapping_vec, repel_radius = 0.35)
ggplot() +
annotate("richtext", x = overlapping_vec, y = 3, label = "**test**", alpha = 0.5) +
annotate("richtext", x = repelled_vec_default, y = 2, label = "**test**", alpha = 0.5) +
annotate("richtext", x = repelled_vec_tighter, y = 1, label = "**test**", alpha = 0.5) +
scale_y_continuous(breaks = 1:3, labels = c("Tighter repel", "Default repel", "Overlapping points"))
In theory you apply this to 2D repelling as well.
To solve the problem in my question, this can be applied like so:
test_img <- list.files(system.file("extdata", package="ggimage"), pattern="png", full.names=TRUE)
set.seed(123)
df <-
tibble(date = as.Date(paste0("2020-", round(runif(45, 1, 2)), "-", round(runif(45, 1, 10)))),
group = paste0("Timeline ", rep(1:9, each = 5)),
img = sample(test_img, size = 45, replace = T) ) %>%
group_by(group) %>%
mutate(repelled_date = repel_vector(as.numeric(date),
repel_radius = 4,
repel_bounds = range(as.numeric(date)) + c(-3,3)),
repelled_date = as.Date(repelled_date, origin = "1970-01-01"))
df %>%
ggplot() +
geom_line(aes(x = date, y = group, group = group), size = 5, alpha = 0.2) +
geom_image(aes(x = repelled_date, y = group, image = img, group = group), asp = 1)
Created on 2021-10-30 by the reprex package (v2.0.1)
I prepare a data.frame as follow;
#create dataframe
df <-data.frame(x = c(rnorm(300, 3, 2.5), rnorm(150, 7, 2)), # create random data
y = c(rnorm(300, 6, 2.5), rnorm(150, 2, 2)),
z = c(rnorm(300, 6, 2.5), rnorm(150, 2, 2)),
group = c(rep('A', 300), rep('B', 150))) # add two groups
The relationship between y and x is like below, when showing by ggplot2;
#for y-x correlation by group with fit curve
gg <- ggplot(df, aes(x=x, y=y)) +
stat_density_2d(geom = "polygon", aes(alpha = ..level..,fill=group))+
geom_smooth(method = 'loess')
print(gg)
Then, I created plot_ly 3D figure as follows;
#plot_ly 3D plot
s = interp(x = df$x, y = df$y, z = df$z,duplicate = "mean") # prepare for plot_ly plot
p <- plot_ly(x = s$x, y = s$y, z = s$z,colorscale = 'Jet')%>% # plot_ly
add_surface()
, which created a graph as below;
Then, here is the question.
I would like to add the first ggplot2 figure at the bottom of the second plot_ly figure, like as below;
Is there any way (function or package) to accomplish this with R?