imageOutput click within conditionalPanel
I am building a shiny app in which users click on an image and this advances them to another image. This seems relatively straightforward, but before the user views the first image, they need to enter their email address. To achieve this, I have been using conditionalPanel where the first image is only displayed once the user hits an action button. However, when the panel for the images is embedded within the conditionalPanel , the click argument for imageOutput seems to stop working.
I have a directory named images with 9 images contained within it, with file names 1.png, 2.png...9.png (by the way, if there is a way of uploading this directory to make this example more easily replicable, I'd be happy to take suggestions!). The following MWE -- which does not include the conditionalPanel element -- works well:
library(shiny)
## User interface
ui <- fluidPage(
h1("MWE",align="center"),
fluidRow(
column(4, conditionalPanel(condition = "input.signingo == 0",
wellPanel(
textInput("who",label = "Please enter your email address.", value=""),
actionButton("signingo",label="Go.")
))
),
column(6, align="center",
wellPanel(
imageOutput("image", height = 175, width = 116, click = "photo_click")
)
)
)
)
server <- function(input, output){
values <- reactiveValues(i = 0, selections = sample(1:9,1))
## Load image
output$image <- renderImage({
filename <- normalizePath(file.path(paste0('images/',values$selections,".png")))
# Return a list containing the filename and alt text
list(src = filename,
alt = paste(input$name))
}, deleteFile = FALSE)
## Function to increment counter by one and to randomly select new image
click.function <- function(){isolate({
values$i <- values$i + 1
values$selections <- sample(1:9,1)
})}
## Move on
observeEvent(input$photo_click,{click.function() })
}
shinyApp(ui = ui, server = server)
However, when I include the conditionalPanel element, clicking on the image no longer seems to produce a new image. This is the code I am using:
library(shiny)
## User interface
ui <- fluidPage(
h1("MWE",align="center"),
fluidRow(
column(4, conditionalPanel(condition = "input.signingo == 0",
wellPanel(
textInput("who",label = "Please enter your email address.", value=""),
actionButton("signingo",label="Go.")
))
),
column(6, align="center",
conditionalPanel(condition = "input.signingo > 0",
wellPanel(
imageOutput("image", height = 175, width = 116, click = "photo_click")
))
)
)
)
server <- function(input, output){
values <- reactiveValues(i = 0, selections = sample(1:9,1))
## Load image
output$image <- renderImage({
filename <- normalizePath(file.path(paste0('images/',values$selections,".png")))
# Return a list containing the filename and alt text
list(src = filename,
alt = paste(input$name))
}, deleteFile = FALSE)
## Function to increment counter by one and to randomly select new image
click.function <- function(){isolate({
values$i <- values$i + 1
values$selections <- sample(1:9,1)
})}
## Move on
observeEvent(input$photo_click,{click.function() })
}
shinyApp(ui = ui, server = server)
The problem is that although the first conditionalPanel seems to be doing its job -- the user sees the "Please enter your email address" first, and only sees the first image after clicking "Go" -- clicking on the image no longer advances the user forward to the next image. Any ideas would be most appreciated.
For testing purposes I generated 9 png files with numbers from 1 to 9 using the following code
for (i in 1:9) {
#png(paste0(i, ".png"), bg = "grey") # you can manipulate the size of graphics
png(paste0(i, ".png"), bg = "grey", height = 400, width = 400)
plot(1:10, type = "n", axes = F, xlab = "", ylab = "")
text(5,5, i, cex = 15, col = i)
box()
dev.off()
}
I also made few changes in your code:
Instead conditional panels there is a dynamic UI which depends on value$i
Initially value$i is set to -1 and textInput and a button are showed
If the user inputs a character string which contains @ and presses the button, the value of value$i is incremented by 1 and the plotOutput is shown.
If there the inputed character string doesn't contain @ a warning is shown ( shinyBS )
The problem is somehow caused by resizing plotOutput using parameters height and width . The input$photo_click doesn't then return a value or more precisely it returns NULL . If the plot is not resized everything works perfectly. So one of the solutions is to put plotOutput inside a div and using very simple CSS to set the desired size of the output.
You can resize the div as follows:
div(style = "background:red; height: 400; width: 400;",
imageOutput("image", click = "photo_click")
)
You can play with the values of height and width within a div and with the size of the png files to get a desired result.
...
png(paste0(i, ".png"), bg = "grey", height = 400, width = 400)
...
The background colour is set to be red and png files are grey to make easier the positioning.
I hope that this solution will be helpful to you:
library(shiny)
library(shinyBS)
## User interface
ui <- fluidPage(
uiOutput("dynamic")
)
server <- function(input, output, session){
output$dynamic <- renderUI({
if (values$i == -1) {
list(
h1("MWE", align = "center"),
wellPanel(
textInput("who", label = "Please enter your email address.", value = ""),
actionButton("signingo", label = "Go."),
bsAlert("alert")
)
)
}
else {
fluidRow(
column(4),
column(6,
# imageOutput("image", height = 175, width = 116, click = "photo_click")
# Setting a custom height and width causes the problem.
# You can wrap imageOutput into a div.
div(style = "background:red; height: 400; width: 400;",
imageOutput("image", click = "photo_click")
)
)
)
}
})
# values$i changed to -1
values <- reactiveValues(i = -1, selections = sample(1:9,1))
## Load image
output$image <- renderImage({
filename <- normalizePath(file.path(paste0('images/',values$selections,".png")))
#filename <- paste0("/Users/User/Downloads/images/", values$selections, ".png")
# Return a list containing the filename and alt text
# list(src = filename,
# alt = paste(input$name)) # I don't know what is input$name
list(src = filename,
alt = paste(values$i))
}, deleteFile = FALSE)
## Function to increment counter by one and to randomly select new image
click.function <- function(){ # isolate({
values$i <- values$i + 1
values$selections <- sample(1:9,1)
# })
}
# increment once values$i (from -1 to 0) to close the first menu.
observeEvent(input$signingo, {
#if (input$who != "")
# Require that the inputed string includes @
if (gregexpr(pattern = "@", input$who) != -1) {
click.function()
closeAlert(session, "Alert")
} else {
# If the inputed string doesen't contain @ create a warning
createAlert(session, "alert", "Alert", title = "Not valid email",
content = "", dismiss = T, style = "warning")
}
})
observeEvent(input$photo_click, {
click.function()
})
}
shinyApp(ui = ui, server = server)
上一篇: opengl es纹理顶部32像素的差距