Making persistant selections in Plotly’s legend for animations - r

I am trying to use plotly in R with shiny to animate the movement of XY data points (x = Population, y = Cars) over time for a number of global cities. Each city is grouped/colored by the continent that it is in (i.e. all cities in Asia are coloured the same, all cities in Europe are colored the same, etc). Everything at this stage, including the animation, already works fine with the play button and the date slider correctly working to show the movement of these cities’ results over time.
My problem is that my selections/de-selections of specific continents within the chart’s legend doesn’t persist when animating the chart. For example, if I toggle ‘Europe’ in the legend of the plotly chart, as expected all the data points associated with European cities will disappear. However if I then click the play button to run the animation, the European data points reappear again when they should stay hidden. Is there a plotly setting I can change so that my selections within the legend don’t reappear when I animate?
I have attached 2 images below showing this problem.
1: I have deselected ‘Europe’ from the legend and it is now greyed out. All the European data points disappear as expected. No problems here yet.
#1
2: This is where the problem is. Despite ‘Europe’ still being deselected in the legend, the orange/European data points reappear when dragging the date slider to the next day. Is there a way to ensure that they stay hidden?
#2
I have copied my R code with shiny below.
Thanks for your help!
server.R
library("shiny")
library ("ggplot2")
library ("plotly")
setwd ("C:/Desktop")
file.names <- list.files (pattern = ".csv", recursive = TRUE)
imported <- sapply (file.names, read.csv, header = TRUE, simplify = FALSE)
names (imported) <- gsub (".csv", "", names(imported))
names (imported) <- strptime (names(imported), "%Y%m%d")
for (i in 1:length(imported)) {
imported[[i]]$Date <- names(imported[i])
}
imported <- do.call (rbind, imported)
imported <- as.data.frame (imported)
shinyServer(function(input, output) {
output$chart.animate <- renderPlotly({
chart.xy <- plot_ly()
chart.xy <- add_markers(chart.xy, x = ~Population, y = ~Cars, color = ~Continent, frame = ~Date, ids =~City, data = imported)
chart.xy <- animation_opts(chart.xy, redraw = FALSE)
return (chart.xy)
})
})
ui.R
library("shiny")
shinyUI(fluidPage(
mainPanel(
plotlyOutput('chart.animate')
)
))

In Python3, you can make persistent selections in legend entries through animations by placing all the entries into legend groups with “legendgroup” = “[group name]” in the data dictionaries.
If you put all of the “Asia” series into one legendgroup (and likewise for the other series), your selection / deselection will persist through animations.

Related

Is there a way to have a highlighted chart as well as have interactivity of selecting elements in R?

I have come across a beautiful chart on this webpage: https://ourworldindata.org/coronavirus and interested to know if we can build the same chart in R with functionality of having highlighted series as well as selecting any line on hovering ?
I have build static highlighted charts using gghighlight but those are not interactive.
Plotly can help in interaction but I think they don't work with gghighlight.
So how can we have the combination of both highlight and interactivity in charts as in the link shared on top ?
Is it possible to achieve same results in R ? It would be really helpful if someone could share an example or link that can help.
(UPDATE: May be I can manually highlight lines by creating a factor column instead of using gghighlight and then pass it to ggplotly but then can ggplotly or some other library provide similar results on hover ?)
(NOTE: Not looking for animation. Just need highlighted, hover over interactive chart)
Below is the snapshot of same chart hovered over US (This chart is also similar to the one shared in World Economic Forum many times.)
Using plotly you can use highlight() to achive this.
This is a slightly modified example from here:
library(plotly)
# load the `txhousing` dataset
data(txhousing, package = "ggplot2")
# declare `city` as the SQL 'query by' column
tx <- highlight_key(txhousing, ~city)
# initiate a plotly object
base <- plot_ly(tx, color = I("black")) %>%
group_by(city)
# create a time series of median house price
time_series <- base %>%
group_by(city) %>%
add_lines(x = ~date, y = ~median)
highlight(
time_series,
on = "plotly_hover",
selectize = FALSE,
dynamic = FALSE,
color = "red",
persistent = FALSE
)

R markdown with rotating gallery-like slides for each plot?

So for example suppose I have these three plots
p1 <- iris%>%ggplot(aes(x=Sepal.Length,y=Sepal.Width))+geom_point()
p2 <- iris%>%ggplot(aes(x=Sepal.Length,y=Sepal.Width))+geom_bar(stat="identity", width = 1, fill="#98ff98")
p3 <- iris%>%ggplot(aes(x=Species,y=Sepal.Width))+geom_bar(stat="identity", width = 1, fill="blue")
So instead printing each plot out separately in the html markdown so that the user has to scroll down to view each of the figures, is there a way to output some sort of ui where the left hand side is the plot and right hand side are the selection for the plots. Then the user can simply select which plot to view and it will appear on the left. Is this possible? The reason why I ask is because often I can have 10-20 figures per comparison that can get unwieldy very fast and I think this would be an excellent way to organize them.
thanks!
Maybe something like this can get you started
library(shiny)
# create a list of plots
plots <- list(
p1 = iris%>%ggplot(aes(x=Sepal.Length,y=Sepal.Width))+geom_point(),
p2 = iris%>%ggplot(aes(x=Sepal.Length,y=Sepal.Width))+geom_bar(stat="identity", width = 1, fill="#98ff98"),
p3 = iris%>%ggplot(aes(x=Species,y=Sepal.Width))+geom_bar(stat="identity", width = 1, fill="blue")
)
# put names of plots in a list in sidebar
ui <- fluidPage(sidebarLayout(
sidebarPanel(tags$ul(purrr::map(names(plots), ~tags$li(actionLink(paste0("show", .), .))))),
mainPanel(plotOutput("currentplot"))
))
server <- function(input, output, session) {
# draw the first plot by default
current_plot <- reactiveVal(plots[[1]]);
# set up observers for each of the action links in the UI
purrr::map(names(plots), function(p) {
observeEvent(input[[paste0("show",p)]], {
# set current plot
current_plot(plots[[p]])
})
})
# render whatever the current plot is
output$currentplot <- renderPlot(current_plot())
}
shinyApp(ui, server)
This will give you a list of plots on the left and will draw which ever you click on on the right.
you could probably make this more efficient if you wanted to write some javascript, but this at least gives a basic idea of how it might work.

Having trouble getting 2x2 table Mosaic Plot to display in R-shiny

raw data
I'm creating an Rshiny app that will allow a user to upload some clinical data, and view several different plots, based on the tabs they open. These include a line plot, pie chart, and mosaic plot. I'm able to view the line plot and pie chart, based on the uploaded data and user inputs, but having trouble getting the mosaic plot to appear. I get an error that says "object 'input' not found."
I tried to use the ggmosaic(geom_mosaic), and structable packages in R to display the plot. In my data table of interest, there are 5 columns: REF(reference method result for 2x2 contingency table, which is binary -- either POS or NEG clinical result), Result(4 diff values: True Positive, False negative, True negative, false positive), Value(number of patients for each result), SampleType(type of patient sample-- NS,NP, Overall are the 3 possible data values for this column) and Comparator(POS or NEG clinical result). In parenthesis, I have included the types of values one would expect for each column. Furthermore, For my R shiny mosaic app, I have several user inputs on the left hand side, which will allow the app to be constructed once the user has selected them: select input for REF column, select input for Sample type column, select input for comparator. I have code written inside the server function that uses these 3 inputs to construct the mosaic plot.
EDIT: I have attached my raw data in the link at the very top titled "raw data."
mosaic plot data table - takes data from pie chart, but displays it in a #different visual format
MosaicDF <- reactive({
#display mosaic
Mosaic_filtered <- select(PieData_extracted(),-c(3,5:7))
#data transformation
names(Mosaic_filtered)[1]<-"REF"
Mosaic_filtered$SampleType <- "NS"
Mosaic_filtered$Comparator <- c("POS","NEG","NEG","POS")
Mosaic_filtered$REF <- c("POS","POS","NEG","NEG")
Mosaic_filtered$F2 <- factor(as.character(Mosaic_filtered$Value))
MYRaw <- Mosaic_filtered[rep(rownames(Mosaic_filtered),as.numeric(as.character(Mosaic_filtered$F2))), ]
MYRaw <- as.data.frame(MYRaw)
#update select input for mosaic plot
updateSelectInput(session, inputId = 'REF', label = 'Select Reference column',
choices = names(MYRaw), selected = "")
updateSelectInput(session, inputId = 'SampleType', label = 'Select Sample Type column',
choices = names(MYRaw), selected = "")
updateSelectInput(session, inputId = 'Comparator', label = 'Select Comparator column',
choices = names(MYRaw), selected = "")
return(MYRaw)
})
#display mosaic plot
output$mosaic <- renderPlot({
ggplot(data=MosaicDF())+geom_mosaic(aes(x=product(input$REF,input$Comparator),fill=input$REF))+labs(x="Comparator",y="REF")
})
}
I'm getting the data table(from which the mosaic plot is constructed) to appear as an output, but the mosaic plot itself won't show up. It says:
"Error: object input not found".
The pie chart data table and pie chart itself do appear on the tab for this plot. (There are 3 tabs for each of the different plots within the R shiny app, of which the user can select any of these, choose some inputs from a dropdown menu, and allow an app to be automatically built based on the inputs).
I'm wondering if there's a way to modify the code for either my reactive data table or the plot itself-- should I change my code for ggplot, or use a different mosaic package for the Rshiny format?
Without providing an example consisting of both data and code that folks can copy and run to reliably reproduce your error, it is difficult to say what thing(s) is(are) going wrong.
However, here is an example shiny app based on the titanic example in the help page for geom_mosaic().
library(ggmosaic)
library(rlang)
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("REF", "REF", "Survived"),
selectInput("Comparator", "Comparator", c("Class", "Sex", "Age"))
),
mainPanel(
plotOutput("old_mosaic"),
plotOutput("new_mosaic")
)
)
)
server <- function(input, output) {
titanic_data <- reactive({
data(Titanic)
titanic <- as.data.frame(Titanic)
titanic$Survived <- factor(titanic$Survived, levels=c("Yes", "No"))
titanic
})
output$old_mosaic <- renderPlot({
ggplot(data = titanic_data()) +
geom_mosaic(aes(weight = Freq, x = product(input$REF, input$Comparator), fill = input$REF)) +
labs(title = "Old Way")
})
output$new_mosaic <- renderPlot({
ggplot(data=titanic_data()) +
geom_mosaic(aes(weight = Freq, x = product(!!sym(input$REF), !!sym(input$Comparator)), fill = !!sym(input$REF))) +
labs(title = "New Way")
})
}
shinyApp(ui, server)
The code that produces the first plot is similar to your ggplot code which attempts to use the input$id(s) as is. On my machine, this first plot produces the error you describe, and in other cases it seems this approach produces the same error.
The solution at the time of that post was to substitute aes_string() in place of aes(). However, here we should not do that because aes_string() is soft-deprecated; and more importantly, we cannot just use aes_string() because we still need to contend with the product() element.
Returning to the example app, notice the second plot is rendered without issue. In this code, I have employed the new idiomatic way which converts the input string to a symbol and then unquotes it.
Therefore, if I am correct, and this is the source of your error, then you should wrap each input$id with a !!sym() in your ggplot code.

Extracting the exact coordinates of a mouse click in an interactive plot

In short: I'm looking for a way to get the exact coordinates of a series of mouse positions (on-clicks) in an interactive x/y scatter plot rendered by ggplot2 and ggplotly.
I'm aware that plotly (and several other interactive plotting packages for R) can be combined with Shiny, where a box- or lazzo select can return a list of all data points within the selected subspace. This list will be HUGE in most of the datasets I'm analysing, however, and I need to be able to do the analysis reproducibly in an R markdown format (writing a few, mostly less than 5-6, point coordinates is much more readable). Furthermore, I have to know the exact positions of the clicks to be able to extract points within the same polygon of points in a different dataset, so a list of points within the selection in one dataset is not useful.
The grid.locator() function from the grid package does almost what I'm looking for (the one wrapped in fx gglocator), however I hope there is a way to do the same within an interactive plot rendered by plotly (or maybe something else that I don't know of?) as the data sets are often HUGE (see the plot below) and thus being able to zoom in and out interactively is very much appreciated during several iterations of analysis.
Normally I have to rescale the axes several times to simulate zooming in and out which is exhausting when doing it MANY times. As you can see in the plot above, there is a LOT of information in the plots to explore (the plot is about 300MB in memory).
Below is a small reprex of how I'm currently doing it using grid.locator on a static plot:
library(ggplot2)
library(grid)
p <- ggplot(mtcars, aes(wt, mpg)) +
geom_point()
locator <- function(p) {
# Build ggplot object
ggobj <- ggplot_build(p)
# Extract coordinates
xr <- ggobj$layout$panel_ranges[[1]]$x.range
yr <- ggobj$layout$panel_ranges[[1]]$y.range
# Variable for selected points
selection <- data.frame(x = as.numeric(), y = as.numeric())
colnames(selection) <- c(ggobj$plot$mapping$x, ggobj$plot$mapping$y)
# Detect and move to plot area viewport
suppressWarnings(print(ggobj$plot))
panels <- unlist(current.vpTree()) %>%
grep("panel", ., fixed = TRUE, value = TRUE)
p_n <- length(panels)
seekViewport(panels, recording=TRUE)
pushViewport(viewport(width=1, height=1))
# Select point, plot, store and repeat
for (i in 1:10){
tmp <- grid.locator('native')
if (is.null(tmp)) break
grid.points(tmp$x,tmp$y, pch = 16, gp=gpar(cex=0.5, col="darkred"))
selection[i, ] <- as.numeric(tmp)
}
grid.polygon(x= unit(selection[,1], "native"), y= unit(selection[,2], "native"), gp=gpar(fill=NA))
#return a data frame with the coordinates of the selection
return(selection)
}
locator(p)
and from here use the point.in.polygon function to subset the data based on the selection.
A possible solution could be to add, say 100x100, invisible points to the plot and then use the plotly_click feature of event_data() in a Shiny app, but this is not at all ideal.
Thanks in advance for your ideas or solutions, I hope my question was clear enough.
-- Kasper
I used ggplot2. Besides the materials at https://shiny.rstudio.com/articles/plot-interaction.html, I'd like to mention the following:
Firstly, when you create the plot, don't use "print( )" within "renderPlot( )", or the coordinates would be wrong. For instance, if you have the following in UI:
plotOutput("myplot", click = "myclick")
The following in the Server would work:
output$myplot <- renderPlot({
p = ggplot(data = mtcars, aes(x=mpg, y=hp)) + geom_point()
p
})
But the clicking coordinates would be wrong if you do:
output$myplot <- renderPlot({
p = ggplot(data = mtcars, aes(x=mpg, y=hp)) + geom_point()
print(p)
})
Then, you could store the coordinates by adding to the Server:
mydata = reactiveValues(x_values = c(), y_values = c())
observeEvent(input$myclick, {
mydata$x_values = c(mydata$x_values, input$myclick$x)
mydata$y_values = c(mydata$y_values, input$myclick$y)
})
In addition to X-Y coordinates, when you use facet with ggplot2, you refer to the clicked facet panel by
input$myclick$panelvar1

Shiny Interactive Graph plot showing row names

I am using Shiny and ggplot2 for an interactive graph. I also used "plot1_click" to get x and y locations.
output$selected <- renderText({
paste0("Value=", input$plot1_click$x, "\n",
"Names=", input$plot1_click$y) }) #how to get names???
This is part of server code. Here what I want is, instead of printing the "y" coordinates, I want to print the corresponding name written in y-axis. Is there any possible way for it??
As far as I know clicking points is not supported in plotOutput. Click events will only return coordinates of the click location. Those coordinates can however be used to figure out the nearest point.
This shiny app from the shiny gallery pages uses the function shiny::nearPoints which does exactly that. Here is a minimal example.
library(shiny)
library(ggplot2)
shinyApp(
fluidPage(
plotOutput("plot", click = "plot_click"),
verbatimTextOutput('print')
),
server = function(input, output, session){
output$plot <- renderPlot({ggplot(mtcars, aes(wt, mpg)) + geom_point()})
output$print = renderPrint({
nearPoints(
mtcars, # the plotting data
input$plot_click, # input variable to get the x/y coordinates from
maxpoints = 1, # only show the single nearest point
threshold = 1000 # basically a search radius. set this big enough
# to show at least one point per click
)
})
}
)
The verbatimTextOutput shows you the nearest point to the clicked location. Notice that nearPoints only works with ggplots like that. But the help page suggests that there is also a way to use this with base graphics.

Resources