R中的传单意外地绘制图标 [英] Leaflet in R plotting icons unpredictably

问题描述

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

My Shiny app takes a dataframe like this:

及其子集.

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

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)

不幸的是，这只是我的应用程序正在显示的某种低速性行为的一种症状.如果那是唯一的问题，那我会很高兴的.相反，假设我在他的第一行(应该是Crecent City)中选择John Doe

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)

我会得到:

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) : data length exceeds size of matrix，但这仅用于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.

如此处所述，您可以使用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屋！