宽数据格式作为闪亮地图视图应用程序的输入 - 需要反应式包装器吗？

Question

我在使用宽格式数据中的列作为闪亮地图应用程序的动态输入时遇到问题。

在应用程序中我希望能够：

• 在下拉式菜单中选择点数据的参数（以下示例数据：16 个位置，6 个参数），并使用滑块调整符号大小以表示所选参数的绝对值（以帮助可视化与零的正差和负差）
• 选择任何参数后，保留在

  mapview

  的弹出功能中查看所有参数（列）的能力（

  mapview

  将弹出窗口的列变成行）。似乎过滤后的长格式

  data.frame

  会从弹出/查看角度丢失数据
• 保留鼠标悬停标签上的（非绝对）原始值（例如图像中的

  -7.3

  ）

除了具有这些功能之外，我不知道是否/在哪里需要设置反应式包装器？或者，也许我可以使用另一个以地图为中心的库更轻松地完成所有事情（尽管

mapview

对于很多事情来说都很棒）？

我的尝试在下面注释掉了 - 用户界面按预期工作，除了没有下拉可选择性 - 该应用程序仅限于一个带有

mapview(df["param1"]

和

cex = param1 * input$cex

的工作下拉参数。

这是可重现的

app.r

：

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

## sample earthquake data ##
set.seed(6)
lat <- rnorm(16,-34, 9)
lon <- rnorm(16,-67,.3)
param1 <- rnorm(16, 10, 40)   %>% round(1)
param2 <- rnorm(16, 25, 3)    %>% round(1)
param3 <- rnorm(16, -18, 10)  %>% round(1)
param4 <- rnorm(16, -200, 93) %>% round(1)
param5 <- rnorm(16, 0.1, .09) %>% round(1)
param6 <- rnorm(16, 417, 33)  %>% round(1)
df <- data.frame(lat, lon, param1, param2, param3, param4, param5, 
param6) 
df <- st_as_sf(df, coords = c("lon", "lat"), crs = 4326) 
paramchoices <- colnames(df) %>% .[.!="geometry"]
colorpal = mapviewPalette("mapviewSpectralColors") 
mapviewOptions(fgb = FALSE)

ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(  
sliderInput("cex", "Symbol Size",
            min = 0.000001, max = 10, value = 1, step = 0.000001
),
selectizeInput(
  
  "parameter", "Earthquake Parameter", choices = paramchoices, 
  selected = c("param1"), 
  multiple = FALSE)
),
dashboardBody(
tags$style(type = "text/css", "#mapplot {height: calc(100vh - 80px) !important;}"),
leafletOutput("mapplot")
)
)

server <- function(input, output) {

# df <- reactive ({
#   df %>% mutate(selectedparameter = input$parameter,
#                 selectedparameter_abs = abs(selectedparameter))
# })

output$mapplot <- renderLeaflet({
               m <-   mapview(df["param1"], #mouseover column
               #m <- mapview(df["selectedparameter"],
               cex = param1 * input$cex,  #marker size column
               #cex = df$selectedparameter_abs * input$cex, 
               col.regions = colorpal(100), 
               alpha.regions = 0.3,
               legend = TRUE,
               popup = popupTable(df),
               layer.name =  "selectedparam[unit]") 
 m@map     
}
)}
shinyApp(ui, server)

与绝对值部分相关的更多信息 - 基于地图视图中不同变量的点颜色和符号大小

Answer 1

library(tidyverse)
library(sf)
library(shiny)
library(shinydashboard)
library(leaflet)
library(leafpop) ## for popupTable()
library(mapview)

## sample earthquake data ##
set.seed(6)
data.frame(lat = rnorm(16,-34, 9),
           lon <- rnorm(16,-67,.3),
           param1 = round(rnorm(16, 10, 40), 1),
           param2 = round(rnorm(16, 25, 3), 1),
           param3 = round(rnorm(16, -18, 10), 1),
           param4 = round(rnorm(16, -200, 93), 1),
           param5 = round(rnorm(16, 0.1, .09), 1),
           param6 = round(rnorm(16, 417, 33), 1))

df <- st_as_sf(df, coords = c("lon", "lat"), crs = 4326) 
paramchoices <- colnames(df) %>% .[.!="geometry"]

colorpal = mapviewPalette("mapviewSpectralColors") 
mapviewOptions(fgb = FALSE) ## see https://stackoverflow.com/a/65614281

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sliderInput("cex", "Symbol Size",
                min = 0.000001, max = 10, value = 1, step = 0.000001),
    selectizeInput("parameter", "Earthquake Parameter", 
                   choices = paramchoices, selected = c("param1"), multiple = FALSE)
    ),
  dashboardBody(tags$style(
    type = "text/css", "#mapplot {height: calc(100vh - 80px) !important;}"),
    leafletOutput("mapplot")
    )
  )

server <- function(input, output) { 
  output$mapplot <- renderLeaflet({
    m <- mapview(df[input$parameter],
                 cex = abs(as.data.frame(df)[,input$parameter] * input$cex),
                 col.regions = colorpal(nrow(df)), 
                 alpha.regions = 0.3,
                 legend = TRUE,
                 popup = popupTable(df),
                 layer.name =   paste(input$parameter , "[unit]"))
    m@map
  }
  )}

shinyApp(ui, server)