Bike Sharing

Visualized

Ramnath Vaidyanathan

Create Basic Map

require(rCharts)
L1 <- Leaflet$new()
L1$tileLayer(provider = 'Stamen.TonerLite')
L1$setView(c(40.73029, -73.99076), 13)
L1$set(width = 1200, height = 600)
L1

Fetch Data

Code
Data

network <- 'citibikenyc'
url = sprintf('http://api.citybik.es/%s.json', network)
bike = fromJSON(content(GET(url)))
bike = lapply(bike, function(station){within(station, {
    latitude = as.numeric(lat)/10^6
    longitude = as.numeric(lng)/10^6
  })
})

$name
[1] "W 52 St & 11 Ave"

$latitude
[1] 40.77

$longitude
[1] -73.99

Add Data to Map

L1$geoJson(toGeoJSON(bike))

Add Fill Color

Compute Fill Color

Code
Data

bike <- lapply(bike, function(station){within(station, { 
  fillColor = cut(
    as.numeric(bikes)/(as.numeric(bikes)+as.numeric(free)), 
    breaks = c(0, 0.20, 0.40, 0.60, 0.80, 1), 
    labels = brewer.pal(5, 'RdYlGn'),
    include.lowest = TRUE
  )})
})

$name
[1] "W 52 St & 11 Ave"

$number
[1] 72

$free
[1] 31

$fillColor
[1] #D7191C
Levels: #D7191C #FDAE61 #FFFFBF #A6D96A #1A9641

Add Fill Color to Map

L1$geoJson(toGeoJSON(bike), 
  pointToLayer =  "#! function(feature, latlng){
    return L.circleMarker(latlng, {
      radius: 4,
      fillColor: feature.properties.fillColor || 'red',    
      color: '#000',
      weight: 1,
      fillOpacity: 0.8
    })
  }!#"
)

Add Popup

Add Popup Data

bike <- lapply(bike, function(station){within(station, { 
   popup = iconv(whisker::whisker.render(
'<b>{{name}}</b><br>
<b>Free Docks: </b> {{free}} <br>
<b>Available Bikes:</b> {{bikes}}<br>
<b>Retrieved At:</b> {{timestamp}}'
   ), from = 'latin1', to = 'UTF-8')})
})

<b>W 52 St &amp; 11 Ave</b><br>
<b>Free Docks: </b> 31 <br>
<b>Available Bikes:</b> 6<br>
<b>Retrieved At:</b> 2013-08-19T22:32:15.379168

W 52 St & 11 Ave
Free Docks: 31
Available Bikes: 6
Retrieved At: 2013-08-19T22:32:15.379168

Pass Popup Data to Map

L1$geoJson(toGeoJSON(bike), 
  onEachFeature = '#! function(feature, layer){
    layer.bindPopup(feature.properties.popup)
  } !#',
  pointToLayer =  "#! function(feature, latlng){
    return L.circleMarker(latlng, {
      radius: 4,
      fillColor: feature.properties.fillColor || 'red',    
      color: '#000',
      weight: 1,
      fillOpacity: 0.8
    })
  } !#"
)
L1

Wrap Into Functions

getData <- function(network = 'citibikenyc'){
  require(httr)
  url = sprintf('http://api.citybik.es/%s.json', network)
  bike = fromJSON(content(GET(url)))
  lapply(bike, function(station){within(station, { 
   fillColor = cut(
     as.numeric(bikes)/(as.numeric(bikes) + as.numeric(free)), 
     breaks = c(0, 0.20, 0.40, 0.60, 0.80, 1), 
     labels = brewer.pal(5, 'RdYlGn'),
     include.lowest = TRUE
   ) 
   popup = iconv(whisker::whisker.render(
      '<b></b><br>
        <b>Free Docks: </b>  <br>
         <b>Available Bikes:</b> 
        <p>Retreived At: </p>'
   ), from = 'latin1', to = 'UTF-8')
   latitude = as.numeric(lat)/10^6
   longitude = as.numeric(lng)/10^6
   lat <- lng <- NULL})
  })
}

plotMap <- function(network = 'citibikenyc', width = 1600, height = 800){
  data_ <- getData(network); center_ <- getCenter(network, networks)
  L1 <- Leaflet$new()
  L1$tileLayer(provider = 'Stamen.TonerLite')
  L1$set(width = width, height = height)
  L1$setView(c(center_$lat, center_$lng), 13)
  L1$geoJson(toGeoJSON(data_), 
    onEachFeature = '#! function(feature, layer){
      layer.bindPopup(feature.properties.popup)
    } !#',
    pointToLayer =  "#! function(feature, latlng){
      return L.circleMarker(latlng, {
        radius: 4,
        fillColor: feature.properties.fillColor || 'red',    
        color: '#000',
        weight: 1,
        fillOpacity: 0.8
      })
    } !#")
  L1$enablePopover(TRUE)
  L1$fullScreen(TRUE)
  return(L1)
}

Plot Map for DC

source('../app/global.R')
dc <- plotMap('capitalbikeshare')

Wrap in Shiny

UI

require(shiny)
require(rCharts)
networks <- getNetworks()
shinyUI(bootstrapPage( 
  selectInput('network', '', sort(names(networks)), 'citibikenyc'),
  mapOutput('map_container')
))

Server

require(shiny)
require(rCharts)
shinyServer(function(input, output, session){
  output$map_container <- renderMap({
    plotMap(input$network)
  })
})