Leaflet and Shiny - Color Control of Shapes

[Aaron Horowitz]

Hi all,

I'm messing around with the new and awesome leaflet+shiny functionality and wanted to see if anyone had any tips of trips for me.

I'm looking to have the color of the circles I add dependent on a condition, rather than fixed for all shapes. I used a little trickery with ggplot to build a function to extract the desired color gradient and assign it to each location on my map. However, when I try to put this into my function, I end up getting a black circle instead of the colors I intended.

Here is a chunk of my code, which is not giving desired color output:

  observe({

    map$clearMarkers()

    map$clearShapes()

    values$onMapStations <- colorsInBound()

    stationDF <- values$onMapStations

    

      map$addCircle(

      stationDF$latitude,

      stationDF$longitude,

      sqrt(2000) * radiusFactor / max(12, input$map_zoom)^2,

      stationDF$gid,

      list(

        weight=1.2,

        fill=TRUE,

        color=stationDF$colour

      )

    )

    })

Any thoughts?

Thanks guys, loving the new geospatial capabilities added with leaflet, I see a lot of potential

[Udrescu Tudor]

Hi Aaron,

without seeing the rest of your code, my guess is that your data.frame converts the color strings into factors. When Shiny passes the parameters onto the Leaflet library, this finds no valid colors and uses the default black value. To supress this behaviour you could use stringsAsFactors = FALSE when constructing your data.frame.

Below is a reproducible example. Not the prettiest R code, but might be useful to someone.

library(shiny)

library(leaflet)

library(RColorBrewer)

library(plyr)

runApp(

  list(

      server=function(input, output, session) {

        

        # create the map

        map <- createLeafletMap(session, 'map')

 

        # create some points 

        DF <- data.frame(

                  lat = c(52.4912694, 49.04323, 49.04323),

                  lon = c(13.292079, 13.49518, 8.39053), 

                  id = c("A","B","C"),

                  myVar = runif(3,100,400),

                  color = c(brewer.pal(3,"Set3")) ,

                  stringsAsFactors = FALSE)

        

        radiusFactor <- 10000

        

        observe({ 

            if(input$drawPoints == 0) {

              return(NULL)

            } else {

              

            map$clearShapes()

            

            # get data into a nested list with the dlply function. 

            paramList <- dlply(DF, 2, function(x) {

              list(x[['lat']], 

                   x[['lon']], 

                   x[['myVar']]*radiusFactor/ max(12, input$map_zoom)^2, 

                   x[['id']], 

                   list(weight = 1.2,                      # stroke weight

                        fill = T,                               # fill object

                        color = '#808080',               # stroke color, grey

                        opacity = 0.9,                    # stroke opacity

                        fillColor = x[['color']],           # fill color

                        fillOpacity = 0.7,                 # fill opacity

                        clickable = T)

              )})

            # call lapply with custom wrapper function to map$addCircle. 

            # the names of the list have to be stripped before being sent to map$addCircle

            lapply(paramList, function(x) do.call(map$addCircle, unname(x)))

           }

        })

      },

      ui=basicPage(

        mainPanel(

          leafletMap("map", "100%", 550, initialTileLayer = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png",

                    initialTileLayerAttribution = HTML('&copy; <a href="http://openstreetmap.org">OpenStreetMap</a> contributors, 

                                                                     <a href="http://creativecommons.org/licenses/by-sa/2.0/">CC-BY-SA</a>'),

                    options = list(center = c(51.01, 8.68), zoom = 6, maxZoom = 10, minZoom=4, maxBounds = list(list(30,-20),list(68,90)))),

          actionButton("drawPoints", "Draw"))

      ))

)

Regards,

Tudor

[Franco Peschiera]

I am currently playing with circles in the leaflet package. I have seen Udrescu's proposal to run "map$addCircle" for every circle with lapply: that would probably work. But what I've been using (with success) is "map$addCircle" with all circles at the same time (which, as the "population" example application from Joe Cheng shows, works). 

Where I'm having issues is when trying to define colors for each circle with this method.

I've seen that there is in the leaflet library an "options" argument in addCircle that I'm guessing cannot be used to define circle-specific properties but is a "default" settings (one color for all circles). Just as the "defaultOptions" in "map$addPolygon". In fact, I get the following error in javascript console when adding a list that has options for each circle:

1. Uncaught Error: Invalid column name "0" binding.js:65
1. DataFrame.colbinding.js:65
2. (anonymous function)binding.js:93
3. jQuery.extend.eachjquery.js:384
4. DataFrame.cbindbinding.js:92
5. methods.addCirclebinding.js:374
6. (anonymous function)binding.js:228
7. _sendMessagesToHandlersshiny.js:831
8. (anonymous function)shiny.js:914
9. _sendMessagesToHandlersshiny.js:831
10. dispatchMessageshiny.js:815
11. socket.onmessage

I've also seen there is an "eachOptions" argument that I thought could be used to give a list of options for each specific circle (just as the "options" in "add$Polygon" (it would be a good idea to share the naming between the two). The problem is that it did not work as expected. Maybe the format is different? I tried giving named lists and unnamed lists but with no luck (i got some errors in the javascript console: Uncaught Error: Invalid column name "0").

Is there a way to give specific options for each circle when calling addCircle with a vector of latitudes?

regarding documentation of leaflet library, I am more than welcome to help start writing it... as long as I know in which format : )

thanks!

Franco