r - 如何从下拉菜单将图像上传到闪亮的应用程序

Question

我正在尝试将图像上传到我闪亮的应用程序，但似乎停留在一个基本步骤上。图像在我的www目录中。我能够实现一个下拉选项，并希望用户选择mouse.png将上传所述图像的图像（例如，）。但是，图像本身没有上传。

这是我的代码，有人有什么想法吗？

library(shiny)


#create a box function
my.box <- function(title, obj) {
  box(
    title = title,
    status = "primary",
    solidHeader = TRUE,
    collapsible = TRUE,
    plotOutput(obj, height = "300px")
  )
}

# List of choices for selectInput
mylist <- list.files("~/APP/www/")
body <- dashboardBody(tableOutput("filtered_table"), 
                      
                      my.box("Table1", "Table1"))

#create dropbox
ui <- fluidPage(
  
  #drop down box 
  selectInput(inputId ="gene",label = h3("Select an image from below"),choices = mylist), 
  
  #name of the plot. 
  mainPanel(plotOutput("image")) #NOT SURE WHAT TO PLACE HERE
)

#server function
server = shinyServer(function(input, output,session){
  observeEvent(input$myFile, {
    inFile <- input$myFile
    if (is.null(inFile))
      return()
    file.copy(inFile$datapath, file.path("~/APP/www/", inFile$name) )
  })
})

Answer 1

按照闪亮教程中的示例，您可以使用renderImage/ imageOutput。请注意，我已经稍微调整了文件路径。

library(shiny)
library(shinydashboard)


#create a box function
my.box <- function(title, obj) {
    box(
        title = title,
        status = "primary",
        solidHeader = TRUE,
        collapsible = TRUE,
        plotOutput(obj, height = "300px")
    )
}

# List of choices for selectInput
mylist <- list.files("./www")
body <- dashboardBody(tableOutput("filtered_table"), 
                      
                      my.box("Table1", "Table1"))

#create dropbox
ui <- fluidPage(
    
    #drop down box 
    selectInput(inputId ="gene",label = h3("Select an image from below"),choices = mylist), 
    
    #name of the plot. 
    mainPanel(imageOutput("image"))
)

#server function
server = shinyServer(function(input, output,session){
    output$image <- renderImage({
        filename <- normalizePath(file.path('www',
                                            input$gene))
        list(src = filename)
    }, deleteFile = FALSE)
})

shinyApp(ui, server)