r - imageOutput在conditionalPanel中单击

我正在构建一个 Shiny 的应用程序，用户可以在其中单击图像，然后将他们前进到另一个图像。这似乎相对简单，但是在用户查看第一张图像之前，他们需要输入电子邮件地址。为了实现这一点，我一直在使用conditionalPanel，其中仅在用户单击操作按钮后才显示第一张图像。但是，当图像面板嵌入conditionalPanel内时，click的imageOutput参数似乎停止工作。

我有一个名为images的目录，其中包含9张图像，文件名为1.png, 2.png...9.png(顺便说一下，如果可以通过上载此目录的方式使此示例更容易复制，我很乐意提出建议!)。以下MWE-不包括conditionalPanel元素-效果很好:

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)

但是，当我包含conditionalPanel元素时，单击图像似乎不再产生新图像。这是我正在使用的代码:

  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)

问题是，尽管第一个conditionalPanel似乎正在执行其工作-用户首先看到“请输入您的电子邮件地址”，并且仅在单击“执行”后才看到第一张图片-单击该图片不再前进用户前进到下一张图片。任何想法将不胜感激。

最佳答案

为了进行测试，我使用以下代码生成了9个png文件，其编号从1到9

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()
}

我还对您的代码进行了一些更改:

相反，有条件的面板有一个动态的UI，它取决于value$i

最初将value$i设置为-1和textInput，并显示一个按钮

如果用户输入包含@的字符串并按下按钮，则value$i的值将增加1，并显示plotOutput。

如果输入的字符串中不包含@，则显示警告(shinyBS)

问题是由于使用参数plotOutput和height调整width大小而引起的。然后input$photo_click不返回值，或更准确地说，它返回NULL。如果不调整图的大小，一切将正常进行。因此，解决方案之一是将plotOutput放入div内，并使用非常简单的CSS设置所需的输出大小。

您可以按如下方式调整div的大小:

div(style = "background:red; height: 400; width: 400;",
            imageOutput("image", click = "photo_click")
          )

您可以在div中使用height和width的值以及png文件的大小来获得所需的结果。

 ...
 png(paste0(i, ".png"), bg = "grey", height = 400, width = 400)
 ...

背景颜色设置为红色，而png文件则设置为灰色，以便于定位。

我希望此解决方案将对您有所帮助:

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)