Shiny 中传单标记弹出窗口中的图像

Question

在 R 中使用

Leaflet

制作地图时，我经常通过放置 html 行在标记弹出窗口中使用图像。 我想在 Shiny 中制作一张传单地图，允许用户选择照片进入标记弹出窗口。 当我从 Shiny 执行此操作时，容器显示时没有图像，并且它不允许我单击图像以转到其在我的计算机上的位置，就像独立的传单地图一样。 当我将鼠标悬停在容器上时，它确实会显示前面带有

file:///

的文件名，就像我输出带有

htmlwidgets

的传单地图时一样。

下面是该问题的一个简单的工作示例。 您只需要上传 .jpg、png 或 svg。

 ui<-bootstrapPage(div(class="outer",
              tags$style(type ="text/css", ".outer {position: fixed; top: 41px; left: 0; right: 0; bottom: 0; overflow: hidden; padding: 0} #table{white-space: nowrap;}"),

            leafletOutput("map", width = "100%", height="100%"),
              absolutePanel(top = 10, right = 10, width=300, draggable=TRUE,style="background-color: rgba(217, 240, 209, 0.85); border-radius: 10px; padding: 10px",

            fileInput(inputId = "photos", label = "Include photos", multiple = T, accept = c('image/png', 'image/jpeg', 'image/svg'))
                       )))



 server<-function(input, output, session) {

 photos<- reactive({

if (is.null(input$photos))
  return(NULL)

infilee<-input$photos
dirr<-dirname(infilee[1,4])

#reassign that directory to all of the filenames
for ( i in 1:nrow(infilee)) {
  file.rename(infilee[i,4], paste0(dirr,"/",infilee[i,1]))}

photo<-list.files(dirr, full.names=TRUE)


  })



output$map <- renderLeaflet({

leaflet() %>% addProviderTiles("Esri.WorldImagery") %>% 
  fitBounds(-81, 34, -77, 40) %>% 

  addMeasure(
    position = "topleft", primaryLengthUnit = "meters", primaryAreaUnit = "acres", secondaryAreaUnit = "sqmeters",
    activeColor = "#ff6f69", completedColor = "#00a9ff")   

  })


observe({

if (is.null(input$photos))
  return(NULL)

photos()->phdata

popup<-paste0("<div><a target='_blank' href='",phdata,"'><img width=100%, height=100% src='", phdata,"' ></a></div>")

leafletProxy("map") %>% 
 addMarkers( lng=-81, lat=37,popup=popup)

   })
  }

 shinyApp(ui = ui, server = server)

Answer 1

这是我将图像文件从临时文件夹复制到 www 文件夹的代码。

library(shiny)
library(leaflet)
library(mapview)

ui<-bootstrapPage(div(class="outer",
                      tags$style(type ="text/css", ".outer {position: fixed; top: 41px; left: 0; right: 0; bottom: 0; overflow: hidden; padding: 0} #table{white-space: nowrap;}"),

                      leafletOutput("map", width = "100%", height="100%"),
                      absolutePanel(top = 10, right = 10, width=300, draggable=TRUE,style="background-color: rgba(217, 240, 209, 0.85); border-radius: 10px; padding: 10px",

                                    fileInput(inputId = "photos", label = "Include photos", multiple = T, accept = c('image/png', 'image/jpeg', 'image/svg'))
                      )))



server<-function(input, output, session) {

  photos<- reactive({

    if (is.null(input$photos))
      return(NULL)

    infilee<-input$photos
    dirr<-dirname(infilee[1,4])
    www_dir <- file.path(getwd(), "www")

    #rename the files and copy all the files to www directory
    for ( i in 1:nrow(infilee)) {
       file.rename(infilee[i,4], paste0(dirr,"/",infilee[i,1]))
      file.copy( paste0(dirr,"/",infilee[i,1]), www_dir)
      }

    #Since the file is saved in www directory, you just have to pass the file name
    photo<-list.files(www_dir)


  })



  output$map <- renderLeaflet({
    # print(tempdir())
    # print(tempfile())

    leaflet() %>% addProviderTiles("Esri.WorldImagery") %>% 
      fitBounds(-81, 34, -77, 40) %>% 
      addMeasure(
        position = "topleft", primaryLengthUnit = "meters", primaryAreaUnit = "acres", secondaryAreaUnit = "sqmeters",
        activeColor = "#ff6f69", completedColor = "#00a9ff")#%>%saveas(tempdir())    
  })


  observe({

    if (is.null(input$photos))
      return(NULL)

    photos()->phdata
    popup <- popupImage(phdata)
    leafletProxy("map") %>% 
      addMarkers( lng=-81, lat=37,popup=popup)

  })
}

shinyApp(ui = ui, server = server)

使用此代码得到的输出是：

希望有帮助！