Prevent click event of plotOutput getting reset when using a module - r

Question

For my shiny application I use a module with a variant number of inputs. In my main application I want now to create an interactive plot. I added a click event (click = "onClick") handler to the plotOutput. When I click on a point, input$onClick gets updated, but becomes NULL right afterwards.
You can try it out in the application: if you click on a point in the left graph, the values of input$onClick are printed, but become NULL right afterwards.
This has to have something to do with the module, becasue if you click on a point in the right graph the information is persistent.
So it seems that there is some sort of communication between client and server which invalidates input$onclick when using modules. Anything I could do about it?
Code
library(shiny)
library(plyr)
library(ggplot2)
testUI <- function(id) {
ns <- NS(id)
uiOutput(ns("placeholder"))
}
test <- function(input, output, session, n) {
output$placeholder <- renderUI({
do.call(tagList, llply(1:n(), function(i)
numericInput(session$ns(paste("n", i, sep = ".")),
session$ns(paste("n", i, sep = ".")), sample(0:100, 1), 0, 100)))
})
getData <- reactive(unlist(reactiveValuesToList(input)[1:n()]))
list(getData = getData)
}
ui <- fluidPage(
flowLayout(
numericInput("n", "Number of Elements", 3, 1, 10),
testUI("x"),
testUI("y")),
flowLayout(
plotOutput("plot", click = "onClick"),
plotOutput("plot2", click = "onClick2")),
verbatimTextOutput("debug")
)
server <- function(input, output, session) {
getN <- reactive(input$n)
handler <- list(x = callModule(test, "x", getN),
y = callModule(test, "y", getN))
output$plot <- renderPlot({
req(handler$x$getData(), handler$y$getData())
dat <- data.frame(x = handler$x$getData(),
y = handler$y$getData())
qplot(x, y, data = dat)})
output$plot2 <- renderPlot(qplot(mpg, cyl, data = mtcars))
output$debug <- renderPrint(list(input$onClick, input$onClick2))
}
runApp(shinyApp(ui, server))

Answer 1

I rewrote the server, in a trial to track the issue. First, I will highlight what I suspect to be the issue, Then I will write an alternative solution.
First: Possible Issues
I think output$plot is rendered twice, if you put print("here") inside output$plot <- renderPlot({}) , you'll see that with each click, it gets executed twice.
Probably, it gets invalidated twice. I suspect that the issue might be related to using getData <- reactive(unlist(reactiveValuesToList(input)[1:n()])). Because when I replaced it with an alternative reactive expression getData <- reactive(1:n()) , it worked properly.
I think, when one clicks on the plot:
input changes (because it includes input$onClick)
getData <- reactive(unlist(reactiveValuesToList(input)[1:n()])) gets invalidated
the plot object for output$plot gets invalidated because it depends on the previous values.
input reads the current value of onClick which is NULL
library(shiny)
library(plyr)
library(ggplot2)
testUI <- function(id) {
ns <- NS(id)
uiOutput(ns("placeholder"))
}
test <- function(input, output, session, n) {
output$placeholder <- renderUI({
do.call(tagList,
llply(1:n(), function(i)
numericInput(session$ns(paste("n", i, sep = ".")),
session$ns(paste("n", i, sep = ".")), sample(0:100, 1), 0, 100)))
})
getData <- reactive(unlist(reactiveValuesToList(input)[1:n()]))
## TEST: this will work ----------
# getData <- reactive(1:n())
list(getData = getData)
}
ui <- fluidPage(
flowLayout(
numericInput("n", "Number of Elements", 3, 1, 10),
testUI("x"),
testUI("y")),
flowLayout(
plotOutput("plot", click = "onClick"),
plotOutput("plot2", click = "onClick2")),
verbatimTextOutput("debug")
)
server <- function(input, output, session) {
# handler <- list(x = callModule(test, "x", getN),
# y = callModule(test, "y", getN))
#
# output$plot <- renderPlot({
# req(handler$x$getData(), handler$y$getData())
# dat <- data.frame(x = handler$x$getData(),
# y = handler$y$getData())
# qplot(x, y, data = dat)})
getN <- reactive(input$n)
## call modules -------------------
xx <- callModule(test, "x", getN)
yy <- callModule(test, "y", getN)
## data to be plotted in left plot
dat <- reactive({
data.frame(x = xx$getData(),
y = yy$getData())
})
## left plot ------------------
output$plot <- renderPlot({
req(xx$getData(),yy$getData())
print("here")
qplot(x, y, data = dat())
})
## right plot ------------------
output$plot2 <- renderPlot({
qplot(mpg, cyl, data = mtcars)
})
output$debug <- renderPrint(c(input$onClick$x,input$onClick2$y))
# output$debug <- renderPrint(dat())
}
shinyApp(ui = ui, server = server)
Second: Alternative Solution
In this alternative solutions:
test will return nothing
get the coordinates of the numericInput fields in x_coord() & y_coord() (There might be other ways to achieve this).
form the dataframe dat().
req() condition was roughly chosen, but could be anything to achieve the desired result.
library(shiny)
library(plyr)
library(ggplot2)
testUI <- function(id) {
ns <- NS(id)
uiOutput(ns("placeholder"))
}
test <- function(input, output, session, n) {
output$placeholder <- renderUI({
do.call(tagList,
llply(1:n(), function(i)
numericInput(session$ns(paste("n", i, sep = ".")),
session$ns(paste("n", i, sep = ".")), sample(0:100, 1), 0, 100)))
})
}
ui <- fluidPage(
flowLayout(
numericInput("n", "Number of Elements", 3, 1, 10),
testUI("x"),
testUI("y")),
verbatimTextOutput("debug"),
flowLayout(
plotOutput("plot", click = "onClick"),
plotOutput("plot2", click = "onClick2"))
)
server <- function(input, output, session) {
getN <- reactive(input$n)
## call modules -------------------
callModule(test, "x", getN)
callModule(test, "y", getN)
## get coordinates fromnumeric inputs ----------
x_coord <- reactive(sapply((1:input$n),function(x) input[[paste0("x-n.",x)]]))
y_coord <- reactive(sapply((1:input$n),function(x) input[[paste0("y-n.",x)]]))
## create data frame
dat <- reactive({
req(input[[paste0("y-n.",input$n)]]) # could be changed
data.frame(x = x_coord(),
y = y_coord())
})
## render left plot ------------------
output$plot <- renderPlot({
req(input[[paste0("y-n.",input$n)]]) # could be changed
qplot(x, y, data = dat())
})
## render right plot ------------------
output$plot2 <- renderPlot({
qplot(mpg, cyl, data = mtcars)
})
## cat coordinates of clicked points ---------------
output$debug <- renderPrint(c(input$onClick$x,input$onClick$y))
}
shinyApp(ui = ui, server = server)