Leaflet in R plotting icons unpredictably

2019-03-21 06:28发布

问题:

My Shiny app takes a dataframe like this:

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

When initally launched, it looks like this:

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)

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)

and BOOM I get:

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.

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.

Some ideas:

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

回答1:

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

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

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

You could for example add:

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

to create your map.



标签: r leaflet