使用传单在 rshiny 中创建缩略图
create thumbnails in rshiny using leaflet
是否可以在 r 传单中添加小图像(缩略图)而不是 markers/circlemarkers?
我使用 leaflet 在 r shiny 中创建地图,到目前为止效果很好。我有一个大型空间点数据集,地图上显示的每个点都包含与该特定位置相关的图像。
使用传单,我可以通过将鼠标悬停在反应内容中来显示该图像
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)
请根据leaflet documentation尝试以下操作:
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)
是否可以在 r 传单中添加小图像(缩略图)而不是 markers/circlemarkers?
我使用 leaflet 在 r shiny 中创建地图,到目前为止效果很好。我有一个大型空间点数据集,地图上显示的每个点都包含与该特定位置相关的图像。 使用传单,我可以通过将鼠标悬停在反应内容中来显示该图像
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)
请根据leaflet documentation尝试以下操作:
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)