Citi Bike part

Avatar
Posted on Mar 31, 2015

Please check my work on the New York City bike share system here (it is decomposed in 3 posts: http://rpubs.com/Sylvie/

And my Github is here: https://github.com/slardeux

 

 

 

 



 

 

 

Work by Sylvie Lardeux, Student of Feb - April Bootcamp, 2015

The best way to illustrate whether or not at least a bike would be in a given bike station in the New York city bike share system is through a shiny app. I took the GBM model created previously and imported it in this shiny app to predict whether or not a bike will be at a station at hte date and time inputed by the user.

I used the leaflet-shiny package created by Joe Cheng to create the map.

Shiny app ui.R

library(shiny)
library(leaflet)
library(ShinyDash)
library(markdown)

shinyUI(navbarPage(title = "City Bike NYC",
  collapsible = TRUE,
  windowTitle <- 'CityBike',

  tabPanel("About",
    fluidRow(
      column(6,offset = 3,
        includeMarkdown("doc/about.md"))
    )),  
    tabPanel("Map",
               column(3,
                      wellPanel(
                        dateInput('date', label = 'Select a date'),

                        selectInput('hour', label = 'Select an hour',
                                    choices = c('1','2',"3",'4','5',"6",'7','8','9','10','11','12','13','14','15','16','17','18','19',"20",'21','22','23', '0'),
                                    selected = '12', width = '100%'),

                        sliderInput('time',  label = 'Select a time range',
                                    min = 0, max = 60, value = c(0,10), step = 10)
                                )
                      ),
               column(9, 
                      leafletMap(
                        "map", "100%", 800,
                        initialTileLayer = "//{s}.tiles.mapbox.com/v3/slardeux.lda667h9/{z}/{x}/{y}.png",
                        initialTileLayerAttribution = HTML('Maps by <a href="http://www.mapbox.com/">Mapbox</a>'),
                        options=list(center = c(40.736, -73.99), zoom = 14)
                                )
                      )   

    ) #end tabPanel  
  )
)

When the user select a date and time, the app get them and use the get_data.f function to find the prediction. This function calls the get_bin.f function and the get_all.f function (in the case when more than 1 10 minute bin was selected). These function return a data set composed of all the bike station ID, the date and the time; this data set will be use for prediction.

The get_data.f use the monthFit model obtained by running the gbm previously to predict the new data set. Finally, I created a map and added circle to each station location with a color green if the model predict that there is at least a bike and red if not.

Shiny app ui.R

library(shiny)
library(maps)
library(lubridate)
library(gbm)

station <- read.csv('data/station.csv')
station <- apply(station, 2, as.numeric)
station <- as.data.frame(station)
load('data/monthFit')

###########################################################################################################
## Create the data to predict
#########################################################################################################
get_bin.f <- function(df, date, hour, rng){
  newd <- data.frame(month = month(date), hour = as.numeric(hour), dayofweek = format(date, '%a'), min_block = rng)
  newd$weekend <- ifelse(newd$dayofweek %in% c('Sat', 'Sun'), 1, 0)
  newd$rush <- ifelse(newd$hour %in% c(7,8,9, 17, 18, 19) & newd$weekend == 0, 1, 0)
  newd$night <- ifelse(newd$hour %in% c(21:23,0:6), 1, 0)
  newd <- newd[,c(1:3,6:7,5,4)]
  newdata <- data.frame(endid = df$id, newd)
  return(newdata)
}
get_all.f <- function(df, date, hour, rng, tm, len){
  s <- seq(tm[1], tm[2], 10)
  l <- list()
  for(i in 1:len){
    r <- paste0('X', s[i], '.', s[i+1])
    l[[i]] <- get_bin.f(df, date, hour, r)
  }
  df <- data.frame(do.call(rbind, l))
  return(df)
}

##################################################################################
# Main function to get the data to predict and the prediciton to plot
#####################################################################################

get_data.f <- function(df, date, hour, tm){
  nbin <- (tm[2] - tm[1])/10
  rng  <- paste0('X',tm[1], '.', tm[2])
    if(nbin == 1){
      newdf <- get_bin.f(df, date, hour, rng)
    }else{
      newdf <- get_all.f(df, date, hour, rng,tm, nbin)
    }
  mn <- as.numeric(month(date))
  fit <- monthFit[[mn]]
  p <- predict(fit, newdata = newdf, n.trees = 500, type = "response")
  pred <- ifelse(p > .5, 1, 0)
  res <- data.frame(station, p = pred)
  return(res)
}

shinyServer(function(input, output, session) {


  ####################################################################################
  ## create map
  #####################################################################################
  
  map <- createLeafletMap(session, 'map')
  add_circle.f <- function(df, col){
    map$addCircle(
      df$lat,
      df$lon,
      50,
      row.names(df),
      list(
        weight=1.2,
        fill=TRUE,
        color= col,
        fillOpacity = 0.5
      )
    )
  }

  observe({
    map$clearShapes()
    stat <- get_data.f(station, input$date, input$hour, input$time)
    
    if (nrow(stat) == 0)
      return()
    #add circle on the map
      stat1 <- stat[which(stat$p == 1),]
      add_circle.f(stat1, '#00FCA0')
    
      stat0 <- stat[which(stat$p == 0),]
      add_circle.f(stat0, '#FC0000')
  })
  
})

The app has also an about page (a markdown document) to explain how to use it and where it came from. The user needs to first chose a date/time before any point are drawn on the map.


 

About Author

Leave a Comment

No comments found.

View Posts by Categories


Our Recent Popular Posts


View Posts by Tags

#python #trainwithnycdsa 2019 airbnb Alex Baransky alumni Alumni Interview Alumni Reviews Alumni Spotlight alumni story Alumnus API Application artist aws beautiful soup Best Bootcamp Best Data Science 2019 Best Data Science Bootcamp Best Data Science Bootcamp 2020 Best Ranked Big Data Book Launch Book-Signing bootcamp Bootcamp Alumni Bootcamp Prep Bundles California Cancer Research capstone Career Career Day citibike clustering Coding Course Demo Course Report D3.js data Data Analyst data science Data Science Academy Data Science Bootcamp Data science jobs Data Science Reviews Data Scientist Data Scientist Jobs data visualization Deep Learning Demo Day Discount dplyr employer networking feature engineering Finance Financial Data Science Flask gbm Get Hired ggplot2 googleVis Hadoop higgs boson Hiring hiring partner events Hiring Partners Industry Experts Instructor Blog Instructor Interview Job Job Placement Jobs Jon Krohn JP Morgan Chase Kaggle Kickstarter lasso regression Lead Data Scienctist Lead Data Scientist leaflet linear regression Logistic Regression machine learning Maps matplotlib Medical Research Meet the team meetup Networking neural network Neural networks New Courses nlp NYC NYC Data Science nyc data science academy NYC Open Data NYCDSA NYCDSA Alumni Online Online Bootcamp Open Data painter pandas Part-time Portfolio Development prediction Prework Programming PwC python python machine learning python scrapy python web scraping python webscraping Python Workshop R R language R Programming R Shiny r studio R Visualization R Workshop R-bloggers random forest Ranking recommendation recommendation system regression Remote remote data science bootcamp Scrapy scrapy visualization seaborn Selenium sentiment analysis Shiny Shiny Dashboard Spark Special Special Summer Sports statistics streaming Student Interview Student Showcase SVM Switchup Tableau team TensorFlow Testimonial tf-idf Top Data Science Bootcamp twitter visualization web scraping Weekend Course What to expect word cloud word2vec XGBoost yelp