imageOutput在conditionalPanel中单击

时间:2016-05-04 16:30:06

标签: r shiny

我正在构建一个闪亮的应用程序,用户点击图像,然后将它们推进到另一个图像。这似乎相对简单,但在用户查看第一张图片之前,他们需要输入他们的电子邮件地址。为实现此目的,我一直在使用conditionalPanel,其中第一个图像仅在用户点击操作按钮时显示。但是,当图片的面板嵌入conditionalPanel时,click的{​​{1}}参数似乎停止工作。

我有一个名为imageOutput的目录,其中包含9个图像,文件名为images(顺便说一下,如果有一种上传此目录的方法可以使这个示例更容易复制,我很乐意接受建议!)。以下MWE(不包括1.png, 2.png...9.png元素 - 效果很好:

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) 似乎正在完成其工作 - 用户首先看到“请输入您的电子邮件地址”,但只有在点击“开始”后才会看到第一张图片 - 点击在图像上不再使用户前进到下一个图像。任何想法都会受到最高的赞赏。

1 个答案:

答案 0 :(得分:3)

出于测试目的,我使用以下代码生成了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()
}

我的代码也做了一些更改:

  • 相反,条件面板有一个动态用户界面,取决于value$i

  • 最初value$i设置为-1textInput,并显示一个按钮

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

  • 如果输入的字符串不包含@,则会显示警告(shinyBS

使用参数plotOutputheight调整width的大小会导致问题。 input$photo_click不会返回值,或者更确切地说它返回NULL。如果情节没有调整大小,一切都很完美。因此,其中一个解决方案是将plotOutput置于div内,并使用非常简单的CSS来设置所需的输出大小。

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

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

您可以在div中使用heightwidth的值以及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)