Question

我正在建立一个带有传单地图显示的shinydashboard，并且很难根据用户输入显示弹出文本。这是迄今为止的代码（＆＃34;输出$ bar＆＃34;部分可以忽略，因为我还没有开始研究）：

 ## app.R ##
library(shinydashboard)
library(shiny)
library(leaflet)
library(ggplot2)

refs <- read.csv('./BSAProjects/HurricaneModel/Data/monthlyrefinerymeanprod.csv', stringsAsFactors = FALSE)
hurs <- read.csv('./BSAProjects/HurricaneModel/Data/hurrdates.csv', stringsAsFactors = FALSE)

huricon <- makeIcon('http://www.youngsvillepolice.com/wp-content/uploads/2015/11/action-icon-HURRICANE.png',
                    iconWidth = 70,
                    iconHeight = 70)

ui <- dashboardPage(
    dashboardHeader(title = 'Hurricane Model'),
    dashboardSidebar(disable = TRUE),
    dashboardBody(
        fluidRow(
            box(leafletOutput('leaflet'),
                width = '100%')),
        fluidRow(
            box(selectInput('menu','Hurricane', choices = hurs$hurricane)),
            box(plotOutput('bar', 'Production Levels'))
        )
    )
)

server <- function(input, output) {
    colors <- colorFactor(rainbow(length(refs$SPRRegion)), refs$SPRRegion)

    output$leaflet <- renderLeaflet({
        map <- leaflet() %>%
            addTiles(urlTemplate = 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Street_Map/MapServer/tile/{z}/{y}/{x}') %>%
            addCircleMarkers(~Longitude,
                             ~Latitude,
                             popup = paste('<b>EIAID:</b>', refs$EIAID, '<br>',
                                           '<b>SPR Refinery Group:</b>', refs$Refinery.Group, '<br>',
                                           '<b>Refinery:</b>', refs$SprRespondentName, '<br>',
                                           '<b>Capacity:</b>', refs$Capacity, 'MBbl/day'),
                             clusterOptions = markerClusterOptions(),
                             color = ~colors(SPRRegion),
                             data = refs) %>% 
            addMarkers(~longitude, 
                       ~latitude,
                       icon = huricon,
                       popup = paste('<b>Hurricane:</b>', hurs$hurricane,'<br>',
                                     '<b>Date:</b>', hurs$date,'<br>',
                                     '<b>HSI:</b>', hurs$hsi),
                       data = hurs[hurs$hurricane == input$menu,])
    })

    output$bar <- renderPlot({
        bar <- ggplot(hurs, aes())
    })
}


shinyApp(ui, server)

我尝试做的是允许用户通过使用＆＃34; selectInput＆＃34;创建的下拉菜单选择飓风。在UI对象中。然后，这将在传单地图中添加一个标记，其中包含我在＆＃34; addMarkers（popup = ...）＆＃34;

中的信息的弹出窗口

我可以根据下拉菜单选择成功获得将标记放在传单地图上的功能，但弹出文本始终是出现在＆＃34; hurs＆＃34的最后一行中的同一飓风;数据文件。如果我删除该行：

data = hurs[hurs$hurricane == input$menu,]

并将所有飓风改为

data = hurs

那时我没有问题。我的＆＃34; addCircleMarkers＆＃34;中的标签更新没有任何问题。对象要么是因为我怀疑这与根据下拉菜单过滤数据集的方式有关。

有什么想法吗？

Answer 1

在这里看到类似的帖子（How to subset a dataframe and plot with leaflet depending on inputselect in shiny）之后想出来。

似乎问题是子集化数据需要在＆＃34; addMarkers的调用之外生成。＆＃34;我试图在内部进行分组并且正在接收这个问题，但仅仅是将其拉出并在调用＆＃34; renderLeaflet＆＃34;之后立即将其拉出来。工作：

server <- function(input, output) {
colors <- colorFactor(rainbow(length(refs$SPRRegion)), refs$SPRRegion)

output$leaflet <- renderLeaflet({
    hur.subset <- subset(hurs, hurs$hurricane == input$menu) ##PLACED IT HERE
    map <- leaflet() %>%
        addTiles(urlTemplate = 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Street_Map/MapServer/tile/{z}/{y}/{x}') %>%
        addCircleMarkers(~Longitude,
                         ~Latitude,
                         popup = paste('<b>EIAID:</b>', refs$EIAID, '<br>',
                                       '<b>SPR Refinery Group:</b>', refs$Refinery.Group, '<br>',
                                       '<b>Refinery:</b>', refs$SprRespondentName, '<br>',
                                       '<b>Capacity:</b>', refs$Capacity, 'MBbl/day'),
                         clusterOptions = markerClusterOptions(),
                         color = ~colors(SPRRegion),
                         data = refs) %>% 
    addMarkers(~longitude,
                ~latitude,
                icon = huricon,
                popup = paste('<b>Hurricane:</b>', hur.subset$hurricane,'<br>',
                             '<b>Date:</b>', hur.subset$date,'<br>',
                             '<b>HSI:</b>', hur.subset$hsi),
                data = hur.subset)
})

}

Leaflet弹出窗口未使用R中的输入进行更新

1 个答案: