Interactive visuals via plotly in Shiny R
MarMariano opened this issue · comments
Hello Robert,
I have been trying to create an interactive plot via plotly in my Shiny R application.
I have implemented the code example that you made available in the vignette "Basic Detection and Visualisation of Events - Interactive visuals" into Shiny R:
output$Serie_HW <- renderPlotly({
ts_res_sub <- Climatologia()[19200:19300,]
p <-
ggplot(data = ts_res_sub, aes(x = t, y = tMax)) +
geom_line(aes(y = tMax)) +
geom_line(aes(y = seas), colour = "green") +
geom_line(aes(y = thresh), colour = "red") +
geom_flame(aes(
x = t,
y = tMax,
y2 = thresh,
colour = "salmon"
)) +
labs(x = "", y = "Temperature (°C)")
ggplotly(p) })
You mention that geom_flame() should work with plotly starting from version v0.3.6.9002. However, when I run the code in Shiny R, the resulting plot does not highlight heatwave events with filling. Since, I am using heatwaveR_0.4.5 I do not think that this is the issue so I cannot figure out why geom_flame is not working in Shiny R renderPlotly.
Thanks,
Mariano
Hello Mariano,
The plotly package stopped receiving active support near the end of 2020 so I had to remove it as a dependency in the heatwaveR package. Below please find the function necessary to be able to use geom_flame() with ggplotly():
geom2trace.GeomFlame <- function (data,
params,
p) {
x <- y <- y2 <- NULL
# Create data.frame for ease of use
data1 <- data.frame(x = data[["x"]],
y = data[["y"]],
y2 = data[["y2"]])
# Grab parameters
n <- params[["n"]]
n_gap <- params[["n_gap"]]
# Find events that meet minimum length requirement
data_event <- heatwaveR::detect_event(data1, x = x, y = y,
seasClim = y,
threshClim = y2,
minDuration = n,
maxGap = n_gap,
protoEvents = T)
# Detect spikes
data_event$screen <- base::ifelse(data_event$threshCriterion == FALSE, FALSE,
ifelse(data_event$event == FALSE, TRUE, FALSE))
# Screen out spikes
data1 <- data1[data_event$screen != TRUE,]
# Prepare to find the ploygon corners
x1 <- data1$y
x2 <- data1$y2
# # Find points where x1 is above x2.
above <- x1 > x2
above[above == TRUE] <- 1
above[is.na(above)] <- 0
# Points always intersect when above=TRUE, then FALSE or reverse
intersect.points <- which(diff(above) != 0)
# Find the slopes for each line segment.
x1.slopes <- x1[intersect.points + 1] - x1[intersect.points]
x2.slopes <- x2[intersect.points + 1] - x2[intersect.points]
# # Find the intersection for each segment.
x.points <- intersect.points + ((x2[intersect.points] - x1[intersect.points]) / (x1.slopes - x2.slopes))
y.points <- x1[intersect.points] + (x1.slopes * (x.points - intersect.points))
# Coerce x.points to the same scale as x
x_gap <- data1$x[2] - data1$x[1]
x.points <- data1$x[intersect.points] + (x_gap*(x.points - intersect.points))
# Create new data frame and merge to introduce new rows of data
data2 <- data.frame(y = c(data1$y, y.points), x = c(data1$x, x.points))
data2 <- data2[order(data2$x),]
data3 <- base::merge(data1, data2, by = c("x","y"), all.y = T)
data3$y2[is.na(data3$y2)] <- data3$y[is.na(data3$y2)]
# Remove missing values for better plotting
data3$y[data3$y < data3$y2] <- NA
missing_pos <- !stats::complete.cases(data3[c("x", "y", "y2")])
ids <- cumsum(missing_pos) + 1
ids[missing_pos] <- NA
# Get the correct positions
positions <- data.frame(x = c(data3$x, rev(data3$x)),
y = c(data3$y, rev(data3$y2)),
ids = c(ids, rev(ids)))
# Convert to a format geom2trace is happy with
positions <- plotly::group2NA(positions, groupNames = "ids")
positions <- positions[stats::complete.cases(positions$ids),]
positions <- dplyr::left_join(positions, data[,-c(2,3)], by = "x")
positions$PANEL <- positions$PANEL[stats::complete.cases(positions$PANEL)][1]
positions$group <- positions$group[stats::complete.cases(positions$group)][1]
# Run the plotly polygon code
getFromNamespace("geom2trace.GeomPolygon", asNamespace("plotly"))(positions)
}
You should be able to copy and paste this function into your R session. Once it has been loaded into your environment the example you provided here should run. Please let me know if this works for you.
All the best,
-Robert
I have copied and pasted it into my Shiny App but still geom_flame() does not seem to be working. Does it have anything to do specifically with Shiny R?
The order of operations matters. So you need to have this bit of code posted into your shiny app right at the beginning before the UI and server are called. Put it in just after you call the necessary libraries for your shiny app.
I have done what you suggested but still it does not work. Is there still something missing? I mean do I still need to call your function inside renderplotly when I call geom_flame()?
Hello Mariano,
Without seeing the code for your shiny app I can't comment any further on the applicability of this code chunk for how you are trying to achieve the use of geom_flame() in a shiny app. But I can offer an example of how it is used in a shiny app I authored. The code for the shiny app is here for you to reverse engineer what you need: https://github.com/robwschlegel/MHWapp/tree/master/shiny
Specifically, the geom2trace.GeomFlame() function is found at this script from line 93: https://github.com/robwschlegel/MHWapp/blob/master/shiny/functions.R
This function is then loaded into the app via the global script found here on line 45: https://github.com/robwschlegel/MHWapp/blob/master/shiny/global.R
This is unfortunately a rather complex app. But the pieces you need are there. The important thing to consider is that geom2trace.GeomFlame() needs to be loaded after you load the plotly library and before any code that would create plotly figures.
Bonne chance,
-Robert
Thank you Robert,
I am focussing on something else at the moment so I have sidelined this task of turning my plots into interactive plots via plotly for the time being. I will get back to it eventually when I have to.
I am quite new to Shiny R so I still need to get my head around some unique features of Shiny.
Hello,
I understand how it goes. I'll close this issue for now.
Please re-open it in the future as necessary.
All the best,
-Robert