R Shiny Leaflet中的高级弹出窗口

Question

我有一个数据集如下

itemcat country item Price date_today lat lng
Clothes Bangkok Shoes $5 2016-04-27 13.75 100.51 
Clothes Bangkok Tshirt $5 2016-04-27 13.75 100.51 
Clothes Bangkok Skirt $5 2016-04-27 13.75 100.51 
Clothes Bangkok Pants $5 2016-04-27 13.75 100.51
Food    Bangkok Chicken $2 2016-04-27 13.75 100.51
Food    Bangkok Milk   $2  2016-04-27 13.75 100.51
Clothes New York Shoes $5 2016-04-27 40.74 -73.98 
Clothes New York Tshirt $5 2016-04-27 40.74 -73.98 
Clothes New York Skirt $5 2016-04-27 40.74 -73.98 
Clothes New York Pants $5 2016-04-27 40.74 -73.98 

我有一个闪亮的应用程序，允许用户选择itemcat，选择日期，传单将指示在世界地图上提供价格信息的国家/地区。

我想创建弹出窗口，以便弹出窗口能够显示城市及所有项目及其价格，例如： 城市：曼谷， 鞋子 ：5美元， T恤 ：5美元， 裙子 ：5美元， 裤子 ：5美元

但是现在，我在使用我的代码显示这些弹出窗口时遇到了麻烦。 特别是，我不知道如何在弹出窗口中显示多个ITEMS变量列。 弹出“城市：”这个词，但就是这样。

####USER INTERFACE####
ui <- shinyUI(fluidPage(
tabsetPanel(
tabPanel("World Cost of Living",
sidebarLayout(position="right",
sidebarPanel(
selectInput("witem", "Select item of comparison", choices = c("Clothes", "Communication", "Income", "Outside Food", "Prepared Food", "Property Price", "Recreation", "Rent", "Transport", "Utilities")),
dateRangeInput("wdaterange", "Select Date Range", start = min(col$date_today), end = max(col$date_today), format = "yyyy-mm-dd", startview = "month", weekstart = 0, language = "en", separator = " to "),
dateInput("wdate", "Select Date", min = min(col$date_today), format = "yyyy-mm-dd", startview = "month", weekstart = 0, language = "en")),

 mainPanel(leafletOutput('map'))
))
)
)
)



####SERVER####

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

  pal <- colorQuantile("Blues", NULL, n = 5)
  output$map <- renderLeaflet({
  prices<-col[col$itemcat==input$witem & col$date_today==input$wdate[1],]

  leaflet(prices) %>% addTiles() %>% addCircles(lng = ~lng, lat=~lat, stroke=TRUE, color = "black", weight=1, opacity = 0.2, fill = TRUE, fillColor = ~pal(infl), fillOpacity = 0.2 , radius = ~infl*30)
  })

  #~htmlEscape(country[lng==lng & lat==lat])

  # Show a popup at the given location
  showPopup <- function(itemcat, lat, lng, date) {
    selectedItem <- col[col$itemcat == itemcat & col$lat==lat & col$lng==lng & col$date_today==date,]
    content <- as.character(tagList(
      tags$strong("City:", selectedItem$country),
      tags$strong(HTML(sprintf("%s, %s",
                               selectedItem$item, selectedItem$spore
      )))
    ))
    leafletProxy("map") %>% addPopups(lng, lat, content, layerId = itemcat)
  }

  observe({
    leafletProxy("map") %>% clearPopups()
    event <- input$map_shape_click
    if (is.null(event))
      return()

    isolate({
      showPopup(event$id, event$lat, event$lng, event$date)
    })
  })

}

Answer 1

我认为这个问题对你来说已经过时了，但是我遇到了同样的问题并没有答案，所以如果有人在将来遇到同样的问题，他可能会在这里找到答案。

单击标记时显示弹出窗口的最简单方法是在定义标记时传递popup选项。 示例：（server.R）

server <- function(input, output, session){
  pal <- colorQuantile("Blues", NULL, n = 5)

  output$map <- renderLeaflet({
  prices<-col[col$itemcat==input$witem & col$date_today==input$wdate[1],]
  leaflet(prices) %>% 
  addTiles() %>% 
  addCircles(lng = ~lng, lat=~lat, fillColor = ~pal(infl),
             popup = "Hello world!")
  })
}

我故意删除了addCircles许多选项，以便于阅读。 此代码显示带有文本Hello world!的弹出窗口Hello world! 点击标记时。 好的第一步就完成了。 现在让我们显示数据：

server <- function(input, output, session){
  pal <- colorQuantile("Blues", NULL, n = 5)

  output$map <- renderLeaflet({
  prices<-col[col$itemcat==input$witem & col$date_today==input$wdate[1],]
  leaflet(prices) %>% 
  addTiles() %>% 
  addCircles(lng = ~lng, lat=~lat, fillColor = ~pal(infl),
             popup = as.character(tagList(
               sprintf("Itemcat: %s", prices$itemcat), tags$br(),
               sprintf("Date: %s", prices$date_today)
  )))
  })
}

现在，弹出窗口显示项目类别和日期。 请注意，这段代码可能需要编辑，因为我在飞行中进行了改编（在整个不同的数据集上，我使用addCircleMarkers而不是addCircles ），但我认为它非常接近可接受的解决方案。

PS似乎你也可以使用：

popup = paste("Itemcat: ", prices$itemcat, "<br>",
              "Date: ", prices$date_today,"<br>")