first commit

Author: user

README.md

@@ -0,0 +1,21 @@
+### Introduction
+
+This shiny application is a real time bike station information. It provides information on  more than 30 bike self-service stations around the world.
+This application is composed of an interface file (**ui.R**), a server file (**server.R**), and folder where we can find data (**www**).
+
+
+You can see the shiny application in action [here](http://blog.rdata.lu/visualization/bike/)
+
+
+
+
+### Before running the code
+
+Before running the code you should run data_dist.R on R to generate, the file closest_stations.RDS (this file is to large to be save in GitHub). Then you will be abble to run the shiny app.
+The offline version is veloh_API_offline.R, if you have any difficulty to make it run offline, contact me :)
+The shiny server version is ui.R and Server.R
+
+Don't forget to change the path (provide the complete path) depending on where you have saved the file :)
+
+
+Enjoy this application and if you have any issues to make it work correctly, you can always watch my [tutorial video](https://youtu.be/GHRZaiYh2Ac) or [contact me](mailto:kevin.rosamont@rdata.lu).

data_dist.R

@@ -0,0 +1,66 @@
+if(!require('tidyverse')) install.packages('tidyverse')
+library(tidyverse)
+
+path= "/www/"
+closest_stations = readRDS(paste0(path,"closest_stations.RDS"))
+stop = nrow(closest_stations)/5
+stop = (1:stop)*5
+
+#toMin = function(x){
+#        if(x>60){
+#                min = floor(x/60)
+#                sec = substr(x-(60*min),1,2)
+#                res = paste0(min,".",sec, " min")
+#       }else{
+#                res = paste0(x, " sec")
+#        }
+        
+#        return(res)
+#}
+
+
+files <- list.files(path = "/www/destination/", pattern = "destination*")
+
+df_files = data_frame(file=files) %>%
+        mutate(stop_files = as.numeric(gsub("[^0-9]","", files))) %>%
+        arrange(stop_files)
+
+files =   df_files$file
+stop_files =   df_files$stop_files
+
+missing = stop[!stop %in% stop_files]
+missing
+
+too_much = stop_files[!stop_files %in% stop]
+too_much
+setwd("/www/destination/")
+
+mapper = function(x){
+        l=length(x)
+        1:l %>%
+                map(function(y){
+                        #If there is 2 values, choose the smalllest
+                        time=min(x[[y]]$Time[[length(x[[y]]$Time)]])
+                        dist=min(x[[y]]$Distance[[length(x[[y]]$Distance)]])
+                        cbind(time, dist)
+                })
+}
+
+time_dist = function(x){
+        readRDS(x) %>% mapper %>% reduce(rbind)
+}        
+
+df_dist_time = files %>%
+        map(time_dist) %>%
+        reduce(rbind) %>%
+        as.data.frame( )
+
+nrow(df_dist_time)==nrow(closest_stations)
+
+closest_stations = cbind.data.frame(closest_stations, df_dist_time) %>% 
+        select(number, name, contract_name, dest_lat, dest_lng, 
+                            origin_lat, origin_lng, time, dist) 
+
+
+saveRDS(closest_stations , "/Users/user/Desktop/GitHub/shiny_bike/www/closest_stations_full.RDS")
+

server.R

@@ -0,0 +1,251 @@
+#options(shiny.fullstacktrace=TRUE) #usefull for the bugs
+#options(shiny.error = browser)     #usefull for the bugs
+library(shiny)
+library(shinydashboard)
+library(leaflet)
+library(jsonlite)
+library(curl) # make the jsonlite suggested dependency explicit
+library(tidyverse)
+
+#Read data
+contract =readRDS("www/contract.RDS" )
+
+
+#Read station data with the distance (thanks google for computing the distance time)
+closest_stations = readRDS("www/closest_stations_full.RDS")
+closest_stations = closest_stations %>%
+        mutate(name = trimws(gsub("[0-9-]"," ", name)))
+
+#To get the API key: https://developer.jcdecaux.com/#/opendata/vls?page=getstarted
+#Download veloh location through the API
+getvelohdata <- function(contract_name) {
+        url <- paste0("https://api.jcdecaux.com/vls/v1/stations?contract=",contract_name,"&apiKey=YOUR_API_KEY")
+        df_api = jsonlite::fromJSON(url)
+        position.lng = df_api$position$lng
+        position.lat = df_api$position$lat
+        df_api = cbind(df_api %>% select(-position), position.lng, position.lat) %>%
+                mutate( name = trimws(gsub("[0-9-]"," ", name)),
+                        #address = paste0("<a href='https://www.google.com/maps/search/?api=1&query=",position.lat,",",position.lng,"' target='_blank'>",address,"</a>"),
+                        address = paste0("<a href='https://www.openstreetmap.org/?mlat=",position.lat,"&mlon=",position.lng,"#map=15/",position.lat,"/",position.lng,"' target='_blank'>",address,"</a>"),
+                        title_attrib = paste0("Name: ",name,"<br>Adress: ",address,"<br>Available: ",available_bikes,"/",bike_stands),
+                        color= ifelse(status != "OPEN", "red","blue"),
+                        available_bike_stands = ifelse(color=="red",0,available_bikes))
+        return(df_api)
+        
+}
+
+#Convert time to minute and seconds
+toMin = function(x){
+        if(x>60){
+                min = floor(x/60)
+                sec = substr(x-(60*min),1,2)
+                res = paste0(min,".",sec, " min")
+        }else{
+                res = paste0(x, " sec")
+        }
+        
+        return(res)
+}
+
+function(input, output, session) {
+
+
+        # Locations of all active vehicles
+        vehicleLocations <- reactive({
+                # Get interval (minimum 90 seconds)
+                interval <- max(as.numeric(input$interval), 90)
+                # Invalidate this reactive after the interval has passed, so that data is
+                # fetched again.
+                invalidateLater(interval * 1000, session)
+                getvelohdata(input$ncity)
+        })
+        
+        # Get time that  locations were updated
+        lastUpdateTime <- reactive({
+                vehicleLocations() # Trigger this reactive when vehicles locations are updated
+                Sys.time()
+        })
+        
+        # Number of seconds since last update
+        output$timeSinceLastUpdate <- renderUI({
+                # Trigger this every 5 seconds
+                invalidateLater(5000, session)
+                
+                p(
+                        class = "text-muted",
+                        "Data refreshed ",
+                        round(difftime(Sys.time(), lastUpdateTime(), units="secs")),
+                        " seconds ago."
+                )
+                
+        })
+        
+        output$localTime <- renderUI({
+                if(input$ncity=="Brisbane"){
+                        timezone="Australia/Brisbane"
+                }else if(input$ncity=="Dublin"){
+                        timezone="Europe/Dublin"
+                }else if(input$ncity=="Vilnius"){
+                        timezone="Europe/Vilnius"
+                }else if(input$ncity=="Toyama"){
+                        timezone="Asia/Tokyo"
+                }else if(input$ncity=="Kazan"){
+                        timezone="Europe/Moscow"
+                }else{
+                        timezone="Europe/Paris"
+                }
+                hour <- Sys.time()
+                time = format(hour,tz=timezone)
+                time = substr(time,12,16)
+                p(class = "text-muted",
+                  br(),
+                  "Source data updates every 90 seconds.",
+                  br(),br(),br(),
+                  "Last update was at ", time,br(), " (Current local time in", input$ncity,")."
+                )
+        })
+        
+        output$Box1 = renderUI(
+                selectInput('nstation', 'Station:', vehicleLocations()$name)
+        )
+        
+        output$Box2 = renderUI({
+                selectizeInput('ncity', 'City:', contract$Contract, selected = "Luxembourg",
+                               options = list(
+                                       valueField = 'url',
+                                       labelField = 'name',
+                                       searchField = 'name',
+                                       options = list(),
+                                       create = FALSE,
+                                       #To add the flag next to the countries
+                                       render = I("{
+                                                  option: function(item, escape) {
+                                                  return '<div>' +
+                                                  '<img src=\"image/flag/' + 
+                                                  (item.name) + 
+                                                  '.png\" width=20 />'  +
+                                                  '&nbsp; &nbsp; &nbsp;' + 
+                                                  escape(item.name) +
+                                                  '</div>';
+        }
+        }")))
+        })
+        
+        output$velohTable <- renderUI({
+                locations <- vehicleLocations()
+                
+                station = locations %>%
+                        filter(name==input$nstation)
+                
+                closest = closest_stations %>%
+                        filter(contract_name==input$ncity & origin_lat==station$position.lat &
+                                       origin_lng == station$position.lng) %>%
+                        arrange(dist) %>%
+                        .[1:5,]
+                destination = left_join(closest, locations, by=c("name")) %>%
+                        select(name, available_bikes, bike_stands, address, dist, time, status) %>%
+                        mutate(time = toMin(time), dist= paste0(dist," m"), name=trimws(gsub("[0-9-]"," ", name)),
+                               status=ifelse(status=="OPEN", "#46abdd", "#d13d2d"),
+                               available_bikes= paste0(available_bikes,"/", bike_stands))
+                
+                
+                # Create a Bootstrap-styled table
+                tags$table(class = "table",
+                           tags$h4(paste0("THE 5 Nearest stations to pick a bike from: ",input$nstation),
+                                   id='title_tb'),
+                           tags$thead(
+                                   tags$tr(
+                                           tags$th(id="th_name","Station Names"),
+                                           tags$th(id="th_avail","Availables"),
+                                           tags$th(id="th_add","Address"),
+                                           tags$th(id="th_dist","Distance"),
+                                           tags$th(id="th_time","Time")
+                                   )),
+                           tags$tbody(
+                                   tags$tr(
+                                           tags$td(class="td_name", tags$span(style = sprintf(
+                                                   "width:0.9em; height:0.9em; background-color:%s; display:inline-block;
+                                                   -webkit-border-radius: 0.6em; -moz-border-radius: 0.6em; border-radius: 0.6em;",
+                                                   destination$status[1]
+                                           )),destination$name[1]),
+                                           tags$td(class="td_avail", destination$available_bikes[1]),
+                                           tags$td(class="td_add", HTML(destination$address[1])),
+                                           tags$td(class="td_dist", destination$dist[1]),
+                                           tags$td(class="td_time", destination$time[1])
+                                           
+                                   ),
+                                   tags$tr(
+                                           tags$td(class="td_name", tags$span(style = sprintf(
+                                                   "width:0.9em; height:0.9em; background-color:%s; display:inline-block;
+                                                   -webkit-border-radius: 0.6em; -moz-border-radius: 0.6em; border-radius: 0.6em;",
+                                                   destination$status[2]
+                                           )),destination$name[2]),
+                                           tags$td(class="td_avail", destination$available_bikes[2]),
+                                           tags$td(class="td_add", HTML(destination$address[2])),
+                                           tags$td(class="td_dist", destination$dist[2]),
+                                           tags$td(class="td_time", destination$time[2])
+                                   ),
+                                   tags$tr(
+                                           tags$td(class="td_name", tags$span(style = sprintf(
+                                                   "width:0.9em; height:0.9em; background-color:%s; display:inline-block;
+                                                   -webkit-border-radius: 0.6em; -moz-border-radius: 0.6em; border-radius: 0.6em;",
+                                                   destination$status[3]
+                                           )),destination$name[3]),
+                                           tags$td(class="td_avail", destination$available_bikes[3]),
+                                           tags$td(class="td_add", HTML(destination$address[3])),
+                                           tags$td(class="td_dist", destination$dist[3]),
+                                           tags$td(class="td_time", destination$time[3])
+                                   ),
+                                   tags$tr(
+                                           tags$td(class="td_name", tags$span(style = sprintf(
+                                                   "width:0.9em; height:0.9em; background-color:%s; display:inline-block;
+                                                   -webkit-border-radius: 0.6em; -moz-border-radius: 0.6em; border-radius: 0.6em;",
+                                                   destination$status[4]
+                                           )),destination$name[4]),
+                                           tags$td(class="td_avail", destination$available_bikes[4]),
+                                           tags$td(class="td_add", HTML(destination$address[4])),
+                                           tags$td(class="td_dist", destination$dist[4]),
+                                           tags$td(class="td_time", destination$time[4])
+                                   ),
+                                   tags$tr(
+                                           tags$td(class="td_name", tags$span(style = sprintf(
+                                                   "width:0.9em; height:0.9em; background-color:%s; display:inline-block;
+                                                   -webkit-border-radius: 0.6em; -moz-border-radius: 0.6em; border-radius: 0.6em;",
+                                                   destination$status[5]
+                                           )),destination$name[5]),
+                                           tags$td(class="td_avail", destination$available_bikes[5]),
+                                           tags$td(class="td_add", HTML(destination$address[5])),
+                                           tags$td(class="td_dist", destination$dist[5]),
+                                           tags$td(class="td_time", destination$time[5])
+                                   )
+                           )
+                )
+        })
+        
+        
+        output$velohmap <- renderLeaflet({
+                locations <- vehicleLocations()
+                
+                station = locations %>%
+                        filter(locations$name==input$nstation)
+                
+                locations = locations %>%
+                        mutate(color=ifelse(name==station$name,"green",color))
+                
+                #The format of the icons
+                icons <- awesomeIcons(
+                        icon = 'ios-close',
+                        iconColor = 'white',
+                        library = 'ion',
+                        markerColor = locations$color,
+                        fontFamily = "serif",
+                        text= as.character(locations$available_bike_stands)
+                )
+                leaflet(locations) %>% setView(lng = station$position.lng, lat = station$position.lat, zoom = 14) %>%
+                        addTiles() %>%
+                        #Nice function that allows you to do a lot of things, I recommand to read the documentation.
+                        addAwesomeMarkers(~position.lng, ~position.lat,
+                                          label=~available_bikes,
+                                          icon=icons, popup = ~title_attrib)
+        })
+}

ui.R

@@ -0,0 +1,43 @@
+library(shiny)
+library(shinydashboard)
+library(leaflet)
+#This is code manage the shiny application interface 
+header <- dashboardHeader(
+        title = div(tags$span("JCDecaux Bike Sevices ",tags$span(" ",id="white_space"), tags$img(src="image/share_bike.png", id="logo_title"))
+        )
+)
+body <- dashboardBody(
+        fluidRow(
+                column(width = 12,
+                       box(width = NULL, solidHeader = TRUE,
+                           leafletOutput("velohmap", height = 500)
+                       ),
+                       box(width = NULL,
+                           uiOutput("velohTable")
+                       )
+                ),
+                absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
+                              draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
+                              width = 330, height = "auto",
+                              
+                              h4("STATIONS TO PICK A BIKE"),
+                              
+                              box(width = NULL, status = "warning",
+                                  uiOutput("Box1"),
+                                  uiOutput("Box2"),
+                                  uiOutput("timeSinceLastUpdate"),
+                                  uiOutput("localTime")
+                              )
+                )
+        )
+)
+
+shinyUI(dashboardPage(
+        header,
+        dashboardSidebar(
+                tags$head(
+                        tags$link(rel = "stylesheet", type = "text/css", href = "stylesheet.css")
+                ),
+                disable = TRUE),
+        body)
+)