rggplot2plotlyggplotly
keep line graphs after the frame ends in r ggplotly
I am trying to create an interactive plot. My lines have different frames (some end shorter). When I play the animation, the lines disappear after their frame ends. I tried to add more rows of fake data with the added frames but that didn't make a difference. I am not sure why this is happening.
Sample Data:
> dput(sample_n(Plot, 20))
structure(list(Strain = c(0.0114976650717703, 0.0283627375, 0.00173272727272728,
0.0150241, 0.0450557, 0.0113663, 3.97637e-05, 0.0434292, 0.00406928,
0.00207895693779905, 0.000215139, 0.00148572499999999, 0.0418233875,
0.000939926, 0.000255219, 0.0213334, 0.023816, 0.0145059, 0.0131467081339713,
0.0668966), Stress = c(75.9505644091148, 78.5302055162329, 48.6062116858257,
68.4024611345473, 85.2904610049016, 63.9140059100703, 1.43583171490823,
84.8256506176318, 64.1272033757161, 53.8795512181689, 14.442082799196,
64.3587637619208, 84.731707366194, 25.4200560130662, 13.8571035440045,
84.1313452985436, 85.4161843153761, 67.9158653588222, 77.7143709896995,
90.4239965485986), Instrumentation = structure(c(2L, 2L, 2L,
1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L,
1L), .Label = c("DIC", "LVDT"), class = "factor"), Bar = structure(c(1L,
2L, 1L, 2L, 2L, 2L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 1L, 1L,
2L, 1L, 2L), .Label = c("Spliced", "Unspliced"), class = "factor"),
ANIM = c(0.01, 0.03, 0, 0.02, 0.05, 0.01, 0, 0.04, 0, 0,
0, 0, 0.04, 0, 0, 0.02, 0.02, 0.01, 0.01, 0.07), frame = c(0.05,
0.05, 0.04, 0.13, 0.05, 0.1, 0.01, 0.11, 0.02, 0, 0.04, 0.11,
0.09, 0.01, 0.01, 0.04, 0.06, 0.09, 0.05, 0.08)), row.names = c(NA,
-20L), class = "data.frame")
The frames are created by the function:
accumulate_by <- function(dat, var) {
var <- lazyeval::f_eval(var, dat)
lvls <- plotly:::getLevels(var)
dats <- lapply(seq_along(lvls), function(x) {
cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
})
dplyr::bind_rows(dats)
}
I have the following for the plot:
plot <- ggplot(Plot) + aes(x = Strain, y = Stress, colour = Instrumentation, linetype = Bar, frame = frame) +
scale_color_manual(values = c("DIC"="red", "LVDT"="blue")) + geom_line(size = 0.8) + theme_classic() +
labs(x = "Strain (in/in)", y = "Stress (ksi)") +
theme_classic() + theme(axis.text = element_text(color = "black", size = 16),
axis.line = element_line(color = "black", size = 0.2), axis.ticks.y = element_line(color = "black", size = 0.2),
axis.title.y = element_text(color = "black", size = 20, margin = margin(0,40,0,0)),
axis.title.x = element_text(color = "black", size = 20, margin = margin(35,0,0,0)),
legend.title = element_blank(), legend.text = element_text(color = "black", size = 16))
ggplotly(
p = ggplot2::last_plot(),
width = NULL,
height = NULL,
tooltip = c("Strain","Stress","Instrumentation","Bar"),
dynamicTicks = FALSE,
layerData = 1,
originalData = TRUE,) %>% animation_opts(frame = 300, transition = 0, easing = "linear", redraw = TRUE) %>%
layout(yaxis = list(title = list(text = "Stress (ksi)", standoff = 30L), spikesides = TRUE,spikethickness = 1),
xaxis = list(title = list(text = "Strain (in/in)",standoff = 30L), spikesides = TRUE,spikethickness = 1),
legend = list(orientation = "v", x = 0.7, y = 0.13)) %>% animation_slider(hide = TRUE)
Also, the redraw doesn't seem to do what I want. I want the plot to start with the complete graph (last frame and all lines) and then also end with everything completed. I only want the animation when pressing the play button.
EDITED:
The initial data is comprised of multiple dataframes. I accumulated the frames for each dataframe independently and then collected them in a single dataframe with rbind.
> dput(sample_n(Plot.Spliced_DIC, 5))
structure(list(Strain = c(0.00635239, 0.00646411, 0.00304078,
0.00104394, 0.00138191), Stress = c(64.9199586945409, 65.0674673934705,
60.7649363239015, 26.5627079525764, 39.4159208404832), Instrumentation = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "DIC", class = "factor"), Bar = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "Spliced", class = "factor"), ANIM = c(0.01,
0.01, 0, 0, 0)), class = "data.frame", row.names = c(NA,
-5L))
> dput(sample_n(Plot.Unspliced_DIC, 5))
structure(list(Strain = c(7.66444e-05, 0.112481, 6.7294e-05,
0.00275991, 0.0600871), Stress = c(0.00344797841982851, 92.8897366602444,
0.522824377824084, 64.3513766859271, 88.2700702030104), Instrumentation = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "DIC", class = "factor"), Bar = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "Unspliced", class = "factor"), ANIM = c(0,
0.11, 0, 0, 0.06)), class = "data.frame", row.names = c(NA,
-5L))
> dput(sample_n(Plot.Unspliced_LVDT, 5))
structure(list(Strain = c(0.071858225, 0.0020442, 0.01736605,
0.0259565, 0.025441275), Stress = c(90.4766041042011, 60.701740404307,
70.0774864366534, 76.21702132901, 75.9110679987475), Instrumentation = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "LVDT", class = "factor"), Bar = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "Unspliced", class = "factor"), ANIM = c(0.07,
0, 0.02, 0.03, 0.03)), class = "data.frame", row.names = c(NA,
-5L))
> dput(sample_n(Plot.Spliced_LVDT, 5))
structure(list(Strain = c(0.0238954832535885, 0.00040463157894736,
0.0158640956937799, 0.0224346507177033, 0.00269568421052631),
Stress = c(85.3207044456991, 14.881393139828, 79.7864191978379,
84.4980682215488, 56.6941352672259), Instrumentation = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "LVDT", class = "factor"), Bar = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "Spliced", class = "factor"), ANIM = c(0.02,
0, 0.02, 0.02, 0)), class = "data.frame", row.names = c(NA, -5L))
Plot.Spliced_DIC <- Plot.Spliced_DIC %>% accumulate_by(~ANIM)
Plot.Unspliced_DIC <- Plot.Unspliced_DIC %>% accumulate_by(~ANIM)
Plot.Unspliced_LVDT <- Plot.Unspliced_LVDT %>% accumulate_by(~ANIM)
Plot.Spliced_LVDT <- Plot.Spliced_LVDT %>% accumulate_by(~ANIM)
Plot <- rbind(Plot.Spliced_DIC, Plot.Unspliced_DIC, Plot.Unspliced_LVDT, Plot.Spliced_LVDT)
Solution
There are two issues regarding your above approach:
- you need to call
accumulate_byafter usingrbind - There seems to be a bug when using the
tooltipargument along with an animation (traces are disappearing - I therefore commented it out)
Please check the following:
library(plotly)
library(dplyr)
accumulate_by <- function(dat, var) {
var <- lazyeval::f_eval(var, dat)
lvls <- plotly:::getLevels(var)
dats <- lapply(seq_along(lvls), function(x) {
cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
})
dplyr::bind_rows(dats)
}
Plot.Spliced_DIC <-
structure(list(Strain = c(0.00635239, 0.00646411, 0.00304078, 0.00104394, 0.00138191),
Stress = c(64.9199586945409, 65.0674673934705, 60.7649363239015, 26.5627079525764, 39.4159208404832),
Instrumentation = structure(c(1L, 1L, 1L, 1L, 1L), .Label = "DIC", class = "factor"),
Bar = structure(c(1L, 1L, 1L, 1L, 1L), .Label = "Spliced", class = "factor"),
ANIM = c(0.01, 0.01, 0, 0, 0)), class = "data.frame", row.names = c(NA, -5L))
Plot.Unspliced_DIC <-
structure(list(Strain = c(7.66444e-05, 0.112481, 6.7294e-05, 0.00275991, 0.0600871),
Stress = c(0.00344797841982851, 92.8897366602444, 0.522824377824084, 64.3513766859271, 88.2700702030104),
Instrumentation = structure(c(1L, 1L, 1L, 1L, 1L), .Label = "DIC", class = "factor"),
Bar = structure(c(1L, 1L, 1L, 1L, 1L), .Label = "Unspliced", class = "factor"),
ANIM = c(0, 0.11, 0, 0, 0.06)), class = "data.frame", row.names = c(NA, -5L))
Plot.Unspliced_LVDT <-
structure(list(Strain = c(0.071858225, 0.0020442, 0.01736605,0.0259565, 0.025441275),
Stress = c(90.4766041042011, 60.701740404307, 70.0774864366534, 76.21702132901, 75.9110679987475),
Instrumentation = structure(c(1L, 1L, 1L, 1L, 1L), .Label = "LVDT", class = "factor"),
Bar = structure(c(1L, 1L, 1L, 1L, 1L), .Label = "Unspliced", class = "factor"),
ANIM = c(0.07,0, 0.02, 0.03, 0.03)), class = "data.frame", row.names = c(NA, -5L))
Plot.Spliced_LVDT <-
structure(list(Strain = c(0.0238954832535885, 0.00040463157894736,
0.0158640956937799, 0.0224346507177033, 0.00269568421052631),
Stress = c(85.3207044456991, 14.881393139828, 79.7864191978379,
84.4980682215488, 56.6941352672259),
Instrumentation = structure(c(1L, 1L, 1L, 1L, 1L), .Label = "LVDT", class = "factor"),
Bar = structure(c(1L, 1L, 1L, 1L, 1L), .Label = "Spliced", class = "factor"),
ANIM = c(0.02, 0, 0.02, 0.02, 0)), class = "data.frame", row.names = c(NA, -5L))
plotData <- rbind(Plot.Spliced_DIC, Plot.Unspliced_DIC, Plot.Unspliced_LVDT, Plot.Spliced_LVDT)
plotData <- plotData %>% accumulate_by(~ANIM)
lastFrame <- with(plotData, plotData[frame == max(frame),])
lastFrame$frame <- -1
plotData <- rbind(lastFrame, plotData) # prepend last frame to show all complete traces in the beginning
plot <- ggplot(plotData) + aes(x = Strain, y = Stress, colour = Instrumentation, linetype = Bar, frame = frame) +
scale_color_manual(values = c("DIC"="red", "LVDT"="blue")) + geom_line(size = 0.8) + theme_classic() +
labs(x = "Strain (in/in)", y = "Stress (ksi)") +
theme_classic() + theme(axis.text = element_text(color = "black", size = 16),
axis.line = element_line(color = "black", size = 0.2), axis.ticks.y = element_line(color = "black", size = 0.2),
axis.title.y = element_text(color = "black", size = 20, margin = margin(0,40,0,0)),
axis.title.x = element_text(color = "black", size = 20, margin = margin(35,0,0,0)),
legend.title = element_blank(), legend.text = element_text(color = "black", size = 16))
ggplotly(
p = ggplot2::last_plot(),
width = NULL,
height = NULL,
# tooltip = c("Strain","Stress","Instrumentation","Bar"), # bug?
# tooltip = c("x","y","colour","linetype"), # bug?
dynamicTicks = FALSE,
layerData = 1,
originalData = TRUE) %>%
animation_opts(frame = 300, transition = 0, easing = "linear", redraw = TRUE) %>%
layout(yaxis = list(title = list(text = "Stress (ksi)", standoff = 30L), spikesides = TRUE,spikethickness = 1),
xaxis = list(title = list(text = "Strain (in/in)",standoff = 30L), spikesides = TRUE,spikethickness = 1),
legend = list(orientation = "v", x = 0.7, y = 0.13)) %>%
animation_slider(hide = TRUE)
By the way the approach to create cumulative animations using accumulate_by will turn slower with more data. Here you can find another approach to create a cumulative animation by filtering the data. However, the R plotly package currently doesn't allow providing custom steps for animation sliders.
Please support my FR if you are interested.
- Floating point less-than-equal comparisons after addition and subtraction
- ggplot fill spilling over shape when used with different geoms
- Compute mutual gaze from individual gazes
- Inverse of gamma function with R
- Conditionally mutating 2 dataframes
- Easiest way to save an S4 class
- Updating values of three dot ellipsis in R
- How to make a multifactor model in pROC?
- Using hidden API to scrape website with JavaScript pager
- Map colours not showing correctly, all SpatRaster values converted to 1 when using crop and mask
- Hierarchical Bayes for R or Python
- How to insert the "Copy to clipboard" icon in an r markdown document
- Name new variables with purrr::map()
- Show every time stamp in plotly x-axis
- Represent the selectInput value in an infoBox
- Display the selectInput value in a R shiny widget box
- SelectInput Value update based on previous SelectInput in R shiny
- Using Conditional Panel with PickerInput in R
- Display multiple infoboxes within one reactive function
- R shiny sever problems - reactive global environment
- Show / Hide selectinput in R shiny based on conditions
- Update data from selectInput
- Usage of UIOutput in multiple menuItems
- Automating the slider of SelectInput
- ggplot - geom_point: setting manual fill color for point jitter without changing boxplot fill color
- why does assigning to the ellipsis `... <- 1` not throw an error?
- checkboxGroupInput delete table output in a shiny app
- ShinyApp: How to pass plot from one module into another one in order to download it in a report?
- Names of a numeric vector with HTML
- How to place elements above the dashboardHeader