R中的传单无法预测地绘制图标 [英] Leaflet in R plotting icons unpredictably

问题描述

我的 Shiny 应用采用如下数据框:

My Shiny app takes a dataframe like this:

并通过允许用户选择人员 (P1_name) 和日期 (date) 来适当地进行子集化.

and subsets appropriately by allowing the user to select a person (P1_name) and a date (date).

最初启动时，它看起来像这样:

When initally launched, it looks like this:

很明显，该应用程序无法正常工作.苹果谷镇的位置应该有一个字母N"，但实际上什么都没有.我不知道为什么，因为 DF 已正确子集化:

and already, it is clear that the app isn't working. There should be a letter 'N' at the location of the town of Apple Valley, but instead there is nothing. I can't figure out why, since the DF has been subsetted correctly:

并且图层应该被正确绘制:

and the layers should be plotted correctly:

m <- leaflet(DF) %>%
  addTiles() %>%  # Add default OpenStreetMap map tiles
  setView(lat=setzoom[1], lng=setzoom[2], zoom=zoom_num) %>%
  addMarkers(lat=subset(DF, P1_outcome=='W')$lat, lng=subset(DF, P1_outcome=='W')$lon, icon = icon_W) %>%
  addMarkers(lat=subset(DF, P1_outcome=='L')$lat, lng=subset(DF, P1_outcome=='L')$lon, icon = icon_L) %>%
  addMarkers(lat=subset(DF, P1_outcome=='D')$lat, lng=subset(DF, P1_outcome=='D')$lon, icon = icon_D) %>%
  addMarkers(lat=subset(DF, P1_outcome=='N')$lat, lng=subset(DF, P1_outcome=='N')$lon, icon = icon_N)

不幸的是，这只是我的应用所显示的某种精神分裂症行为的一种症状.如果这是唯一的问题，我会很高兴.相反，假设我选择 John Doe，在他的第一行(应该是 Crcent City)

Unfortunately, this is just one symptom of some sort of skitzophrenic behavior that my app is displaying. If that was the only problem, I'd be rejoicing. Instead, say I select John Doe, on his first row (which should be Crecent City)

我得到了 BOOM:

Leaflet 到底是怎么认为我给了它两组组坐标来绘制的，是什么让它认为 John Doe 正在太平洋某处溺水.

How in the world did Leaflet think I had given it two sets of coordinates to plot, and what made it think that John Doe was drowing somewhere in the Pacific Ocean.

这里没有什么意义.我在它输出的混乱中看不到任何模式.它只有 100 行简单的代码.

Nothing here makes much sense. I can't see a pattern in the chaos it is outputting. It's barely 100 lines of simple code.

一些想法:

• conditionalPanel 混淆了我的数据框?我不这么认为，因为我可以 View(DF) 并看到这部分不是问题.
• 图标中的分层不起作用?不确定这会是什么问题，因为我们知道是绘制图标的正确方法.
• 我收到 xtable 警告，Warning in run(timeoutMs):数据长度超过矩阵大小，但这仅适用于 tableOutput 部分，我认为这与我遇到的任何问题无关.

• the conditionalPanel is mixing up my dataframe? I don't think so, since I can View(DF) and see that this part isn't the problem.
• the layering in the icons isn't working? Not sure how this would be a problem, as we know that this is the correct way to plot icons.
• I am getting an xtable warning, Warning in run(timeoutMs) : data length exceeds size of matrix, but this is just for the tableOutput part, which I don't think is related to any of the issue I'm beseiged with.

我被难住了.整天卡在这上面.如果有人有任何见解、想法、咒语等，我很想听听.

I'm stumped. Been stuck on this all day. If anyone has any insight, ideas, incantations, etc, I'd love to hear them.

UI.R

library(shiny)
library(ggplot2)
library(dplyr)
library(leaflet)
library(data.table)
options(xtable.include.rownames=F)
library(ggmap)
library(lubridate)

DF <- data.frame(lon=c(-120.6596156, -87.27751, -119.7725868, -124.2026, -117.1858759),  
                 lat=c(35.2827524, 33.83122, 36.7468422, 41.75575, 34.5008311), 
                 date=c('2014-03-14', '2014-01-11', '2013-11-22', '2012-08-23', '2013-08-23'),
                 location=c('San Luis Obispo', 'Jasper', 'Fresno', 'Crescent City', 'Apple Valley'), 
                 P1_name=c('John Doe', 'John Doe', 'John Doe', 'John Doe', 'Joe Blow'),
                 P1_outcome=c('W', 'L', 'D', 'W', 'N'))

DF$date <- as.Date(DF$date, format="%Y-%m-%d")
DF <- arrange(DF, P1_name, date)
DT <- data.table(DF)
DT[, .date := sequence(.N), by = "P1_name"]
DF$date <- paste(DF$date, '   (', DT$.date, ')', sep='')
DF <- arrange(DF, P1_name, desc(date))
DF$P1_name <- as.character(DF$P1_name)
DF$P1_outcome <- as.character(DF$P1_outcome)
DF$location <- as.character(DF$P1_location)
#str(DF$P1_outcome)

icon_W <- makeIcon(
  iconUrl = "http://i58.tinypic.com/119m3r5_th.gif",
  iconWidth = 10, iconHeight = 23,
  iconAnchorX = 10, iconAnchorY =23 
)

icon_L <- makeIcon(
  iconUrl = "http://i62.tinypic.com/2dulcvq_th.jpg",
  iconWidth = 10, iconHeight = 23,
  iconAnchorX = 10, iconAnchorY = 23
)

icon_D <- makeIcon(
  iconUrl = "http://i58.tinypic.com/2zox2yf_th.gif",
  iconWidth = 10, iconHeight = 23,
  iconAnchorX = 10, iconAnchorY = 23
)

icon_N <- makeIcon(
  iconUrl = "http://i62.tinypic.com/339j7de_th.gif",
  iconWidth = 10, iconHeight = 23,
  iconAnchorX = 22, iconAnchorY = 94
)

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

  output$dates<-renderUI({
    selectInput('dates', 'by date / number', choices=DF[which(DF$P1_name == input$person), ]$date, selectize = FALSE)
  })

  output$map<-renderLeaflet({
    validate(
      need(!is.null(input$dates),""),
      need(!is.null(input$person),"")
    )

    if(input$radio=='by date'){
      DF <- filter(DF, P1_name==input$person, date==input$dates)
      View(DF)   
      zoom_num <- 5
      setzoom <- c(DF$lat, DF$lon) 
      outcome <- data.frame(DF$P1_outcome, DF$location)
      output$table <- renderTable(outcome)
    }
    else{
      DF <- filter(DF, P1_name==input$person)
      View(DF)
      zoom_num <- 2
      setzoom <- c(DF$lat[1], DF$lon[1])
      outcome <- data.frame(DF$P1_outcome, DF$location)
      output$table <- renderTable(outcome)
    }



    m <- leaflet(DF) %>%
      addTiles() %>%  # Add default OpenStreetMap map tiles
      setView(lat=setzoom[1], lng=setzoom[2], zoom=zoom_num) %>%
      addMarkers(lat=subset(DF, P1_outcome=='W')$lat, lng=subset(DF, P1_outcome=='W')$lon, icon = icon_W) %>%
      addMarkers(lat=subset(DF, P1_outcome=='L')$lat, lng=subset(DF, P1_outcome=='L')$lon, icon = icon_L) %>%
      addMarkers(lat=subset(DF, P1_outcome=='D')$lat, lng=subset(DF, P1_outcome=='D')$lon, icon = icon_D) %>%
      addMarkers(lat=subset(DF, P1_outcome=='N')$lat, lng=subset(DF, P1_outcome=='N')$lon, icon = icon_N)
  })  #<- end output$map
}     #<- end server function

ui <- fluidPage(
  titlePanel("Location Explorer"),
  sidebarLayout (
    sidebarPanel(
      selectInput('person', 'Select person', choices=unique(DF$P1_name), selectize = FALSE),
      radioButtons('radio', 'Select row(s)', choices=c('by date', 'all'), selected = NULL, inline = TRUE),
      conditionalPanel(
        condition = "input.radio == 'by date'",
        uiOutput('dates')   
      ),
      conditionalPanel(
        condition = "input.radio == 'all'"
      )      
    ),
    mainPanel(
      leafletOutput('map'),      
      fluidRow(column(4, tableOutput('table')))
    ))
)  #<-  end ui

shinyApp(ui = ui, server = server)

推荐答案

其中一个问题可能是您在子集中添加了空标记，而 leaflet 对此做出了奇怪的反应.

One of the issue could be that you are adding empty markers in your subsets and leaflet reacts strangely to that.

例如，当您选择 Joe Blow 时，P1_outcome == "W"、"L" 或 的所有子集>D"为空.

For example, when you select Joe Blow, all the subsets for P1_outcome == "W", "L" or "D" are empty.

如 here 所述，您可以使用 iconList根据 P1_outcome 更改图标并删除所有 subset 的函数.

As described here, you could use the iconList function to change the icons depending on P1_outcome and remove all the subset.

例如，您可以添加:

icon_list <- iconList(W=icon_W,L=icon_L,D=icon_D,N=icon_N)

在你定义所有图标之后，然后使用:

right after you define all the icons, and use:

m <- leaflet(DF) %>%
      addTiles() %>%  # Add default OpenStreetMap map tiles
      setView(lat=setzoom[1], lng=setzoom[2], zoom=zoom_num) %>%
      addMarkers(lat=DF$lat, lng=DF$lon,icon= ~icon_list[DF$P1_outcome]) 

创建您的地图.

这篇关于R中的传单无法预测地绘制图标的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！