使用传单在r闪亮中创建缩略图

Question

是否可以在 r 传单中添加小图像（缩略图）而不是标记/圆圈标记？

我使用 leaflet 在 rshiny 中创建地图，到目前为止效果很好。我有一个大型空间点数据集，地图上显示的每个点都包含与该特定位置相关的图像。 使用传单，我可以通过将鼠标悬停在反应内容中来显示该图像

observeEvent(input$map1_marker_mouseover$id {})

或点击弹出图片。

我现在想要的是，图像的显示无需悬停或单击，而是始终显示（从某个缩放级别）。

在下面找到一个最小的工作示例。

library(shiny)
library(leaflet)
library(mapview)
library(leafpop)
library(sf)


# testdata
loc = data.frame(x = jitter(rep(8.620000, 10), factor = 0.1),
                 y = jitter(rep(47.320000, 10), factor = 0.1))
loc = st_as_sf(loc, coords = c("x", "y"), crs = 4326)
image = 'https://upload.wikimedia.org/wikipedia/commons/thumb/c/c1/Rlogo.png/274px-Rlogo.png'


# === UI ==========================

ui <- fluidPage(
  div(class="outer", # use full space

      # leaflet
      leafletOutput("map1", width="100%", height="100%")),

      # css-styling
      tags$head(tags$style(HTML("
                                           #map{
                                             margin-top:18px;
                                             margin-bottom:18px;
                                           }
                                           .outer {
                                              position: fixed;
                                              top: 0;
                                              left: 0;
                                              right: 0;
                                              bottom: 0;
                                              overflow: hidden;
                                              padding: 0;
                                              margin-top:0;
                                            }
                                           ")))
)


# === Server ==========================
server <- function(input, output, session) {      

  # === map
  output$map1 <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addCircleMarkers(data=loc, radius = 5,
                     clusterOptions = markerClusterOptions(),
                     popup = paste0("<img src = ", image, ">"),
                     group="points") 
  })

}

# === RUN APP ==========================       
shinyApp(ui, server)

Answer 1

请根据传单文档尝试以下操作：

library(shiny)
library(leaflet)
library(mapview)
library(leafpop)
library(sf)


# testdata
loc = data.frame(x = jitter(rep(8.620000, 10), factor = 0.1),
                 y = jitter(rep(47.320000, 10), factor = 0.1))
loc = st_as_sf(loc, coords = c("x", "y"), crs = 4326)
RIcon <- makeIcon(iconUrl = 'https://upload.wikimedia.org/wikipedia/commons/thumb/c/c1/Rlogo.png/274px-Rlogo.png',
                  iconWidth = 20)


# === UI ==========================

ui <- fluidPage(
    div(class="outer", # use full space

        # leaflet
        leafletOutput("map1", width="100%", height="100%")),

    # css-styling
    tags$head(tags$style(HTML("
                                           #map{
                                             margin-top:18px;
                                             margin-bottom:18px;
                                           }
                                           .outer {
                                              position: fixed;
                                              top: 0;
                                              left: 0;
                                              right: 0;
                                              bottom: 0;
                                              overflow: hidden;
                                              padding: 0;
                                              margin-top:0;
                                            }
                                           ")))
)


# === Server ==========================
server <- function(input, output, session) {      

    # === map
    output$map1 <- renderLeaflet({
        leaflet() %>%
            addTiles() %>%
            addMarkers(data=loc, icon = RIcon,
                             clusterOptions = markerClusterOptions(),
                             group="points") 
    })

}

# === RUN APP ==========================       
shinyApp(ui, server)