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'/ p>

但是现在，我在使用我的代码显示这些弹出窗口时遇到了麻烦。特别是，我不知道如何在弹出窗口中显示多个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!的弹出窗口。好的第一步就完成了。现在让我们显示数据：

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>")

R Shiny Leaflet中的高级弹出窗口

1 个答案: