Merge pull request #1 from datasciencecampus/develop

updated pkg
datasciencecampus · Oct 19, 2018 · 8c96a90 · 8c96a90
2 parents 228c285 + d45c670
commit 8c96a90
Show file tree

Hide file tree

Showing 7 changed files with 56 additions and 36 deletions.
diff --git a/propeR/DESCRIPTION b/propeR/DESCRIPTION
@@ -11,6 +11,8 @@ Authors@R: c(
   person("Michael", "Hodge", email = "[email protected]",
   role = c("aut", "cre")),
   person("Phil", "Stubbings", email = "[email protected]",
+  role = c("ctb")),
+  person("Ioannis", "Tsalamanis", email = "[email protected]",
   role = c("ctb")))
 URL: https://github.com/datasciencecampus/propeR
 BugReports: https://github.com/datasciencecampus/propeR/issues

diff --git a/propeR/R/choropleth.R b/propeR/R/choropleth.R
@@ -21,6 +21,7 @@
 ##' @param waitingCutoff in minutes, defaults to 10
 ##' @param transferCutoff defaults to 1
 ##' @param palColor the color palette of the map, defaults to 'Blues'
+##' @param palColorCat the color palette of the catergorical map, defaults to c("#820e0e", "#407746")
 ##' @param mapZoom defaults to 12
 ##' @return Returns a number of maps (duration, wait time, transfers) to the output directory
 ##' @author Michael Hodge
@@ -57,14 +58,16 @@ choropleth <- function(output.dir,
                        transferCutoff=1,
                        # colours
                        palColor="Blues",
+                       palColorCat=c("#820e0e", "#407746"),
                        # leaflet map args
                        mapZoom=12) {
 
   message("Now running the propeR choropleth tool.\n")  
 
   # colours
-  pal_choropleth=colorFactor(palColor, domain=NULL, na.color = "#ffffff") # Creating colour palette
-  pal_choropleth_cat=colorFactor(c("#FF0000", "#228B22"), na.color = "#ffffff", domain=NULL) # Creating colour palette
+  pal_choropleth = leaflet::colorNumeric(palColor, domain=NULL, na.color = "#ffffff") # Creating colour palette
+  pal_choropleth_transfers = leaflet::colorFactor(palColor, domain=NULL, na.color = "#ffffff") # Creating colour palette
+  pal_choropleth_cat = leaflet::colorFactor(palColorCat, na.color = "#ffffff", domain=NULL) # Creating colour palette
 
   dir.create(paste0(output.dir,"/tmp_folder")) # Creates tmp_folder for pngs
 
@@ -153,8 +156,8 @@ choropleth <- function(output.dir,
     if (i < nrow(originPoints)){
       message(i," out of ",nrow(originPoints),
               " connections complete. Time taken ",
-              do.call(sum,time.taken)," seconds. Estimated time left is approx. ",
-              (do.call(mean,time.taken)*nrow(originPoints))-do.call(sum,time.taken),
+              round(do.call(sum,time.taken), digits = 2)," seconds. Estimated time left is approx. ",
+              round((do.call(mean,time.taken)*nrow(originPoints))-do.call(sum,time.taken), digits = 2),
               " seconds.")
     } else {
       message(i," out of ",nrow(originPoints),
@@ -205,6 +208,8 @@ choropleth <- function(output.dir,
   m <- addLegend(m, pal = pal_choropleth, # Adds legend
                  values = choropleth_map$duration,
                  opacity = 1.0,
+                 bins = 5,
+                 na.label = "NA",
                  title = "Duration (minutes)")
   m <- addAwesomeMarkers(m, data = to_destination, # Adds marker for destination
                          lat = ~lat,
@@ -258,6 +263,8 @@ choropleth <- function(output.dir,
   n <- addLegend(n, pal = pal_choropleth, # Adds legend
                  values = choropleth_map$waitingtime,
                  opacity = 1.0,
+                 bins = 5,
+                 na.label = "NA",
                  title = "Wait Time (minutes)")
   n <- addAwesomeMarkers(n, data = to_destination, # Adds marker for destination
                          lat = ~lat,
@@ -303,14 +310,15 @@ choropleth <- function(output.dir,
                lng=to_destination$lon, # Focuses on destination
                zoom=mapZoom)
   o <- addPolygons(o, data = choropleth_map, # Adds polygons for origins
-                   fillColor = ~pal_choropleth(choropleth_map$transfers),
+                   fillColor = ~pal_choropleth_transfers(choropleth_map$transfers),
                    fillOpacity = 1,
                    color = "#BDBDC3",
                    weight = 1,
                    popup = popup_transfers)
-  o <- addLegend(o, pal = pal_choropleth, # Adds legend
+  o <- addLegend(o, pal = pal_choropleth_transfers, # Adds legend
                  values = choropleth_map$transfers,
                  opacity = 1.0,
+                 na.label = "NA",
                  title = "Transfers")
   o <- addAwesomeMarkers(o, data = to_destination, # Adds marker for destination
                          lat = ~lat,
@@ -349,43 +357,43 @@ choropleth <- function(output.dir,
 
 
   # Plots leaflet map in Viewer and saves to disk, also saves table as csv ----------
-  
+
   message("Analysis complete, now saving outputs to ",output.dir,", please wait.\n")
-  
+
   stamp <- format(Sys.time(), "%Y_%m_%d_%H_%M_%S") # Windows friendly time stamp
-  
+
   mapview::mapshot(m, file = paste0(output.dir, "/choropleth_duration-",stamp,".png"))
   htmlwidgets::saveWidget(m, file = paste0(output.dir, "/choropleth_duration-",stamp,".html")) # Saves as an interactive HTML webpage
   unlink(paste0(output.dir, "/choropleth_duration-",stamp,"_files"), recursive = TRUE) # Deletes temporary folder that mapshot creates
   invisible(print(m)) # plots map to Viewer
-  
+
   mapview::mapshot(m_cat, file = paste0(output.dir, "/choropleth_duration_cat-",stamp,".png"))
   htmlwidgets::saveWidget(m_cat, file = paste0(output.dir, "/choropleth_duration_cat-",stamp,".html")) # Saves as an interactive HTML webpage
   unlink(paste0(output.dir, "/choropleth_duration_cat-",stamp,"_files"), recursive = TRUE) # Deletes temporary folder that mapshot creates
   invisible(print(m_cat)) # plots map to Viewer
-  
+
   mapview::mapshot(n, file = paste0(output.dir, "/choropleth_waitingtime-",stamp,".png"))
   htmlwidgets::saveWidget(n, file = paste0(output.dir, "/choropleth_waitingtime-",stamp,".html")) # Saves as an interactive HTML webpage
   unlink(paste0(output.dir, "/choropleth_waitingtime-",stamp,"_files"), recursive = TRUE) # Deletes temporary folder that mapshot creates
   invisible(print(n)) # plots map to Viewer
-  
+
   mapview::mapshot(n_cat, file = paste0(output.dir, "/choropleth_waitingtime_cat-",stamp,".png"))
   htmlwidgets::saveWidget(n_cat, file = paste0(output.dir, "/choropleth_waitingtime_cat-",stamp,".html")) # Saves as an interactive HTML webpage
   unlink(paste0(output.dir, "/choropleth_waitingtime_cat-",stamp,"_files"), recursive = TRUE) # Deletes temporary folder that mapshot creates
   invisible(print(n_cat)) # plots map to Viewer
-  
+
   mapview::mapshot(o, file = paste0(output.dir, "/choropleth_transfers-",stamp,".png"))
   htmlwidgets::saveWidget(o, file = paste0(output.dir, "/choropleth_transfers-",stamp,".html")) # Saves as an interactive HTML webpage
   unlink(paste0(output.dir, "/choropleth_transfers-",stamp,"_files"), recursive = TRUE) # Deletes temporary folder that mapshot creates
   invisible(print(o)) # plots map to Viewer
-  
+
   mapview::mapshot(o_cat, file = paste0(output.dir, "/choropleth_transfers_cat-",stamp,".png"))
   htmlwidgets::saveWidget(o_cat, file = paste0(output.dir, "/choropleth_transfers_cat-",stamp,".html")) # Saves as an interactive HTML webpage
   unlink(paste0(output.dir, "/choropleth_transfers_cat-",stamp,"_files"), recursive = TRUE) # Deletes temporary folder that mapshot creates
   invisible(print(o_cat)) # plots map to Viewer
-  
+
   write.csv(choropleth_table, file = paste0(output.dir, "/choropleth-",stamp,".csv"),row.names=FALSE) # Saves trip details as a CSV
-  
+
   unlink(paste0(output.dir,"/tmp_folder"), recursive = TRUE) # Deletes tmp_folder if exists
 
 }
diff --git a/propeR/R/isochrone-time.R b/propeR/R/isochrone-time.R
@@ -65,8 +65,8 @@ isochroneTime <- function(output.dir,
 
   message("Now running the propeR isochroneTime tool.\n")  
 
-  pal_time_date=colorFactor(c("#FFFFFF"), domain=NULL) # Creating colour palette
-  palIsochrone=colorFactor(palColor, NULL, n=length(isochroneCutOffs)) # Creating colour palette
+  pal_time_date=leaflet::colorFactor(c("#FFFFFF"), domain=NULL) # Creating colour palette
+  palIsochrone=leaflet::colorFactor(palColor, NULL, n=length(isochroneCutOffs)) # Creating colour palette
 
   dir.create(paste0(output.dir,"/tmp_folder")) # Creates tmp_folder folder for pngs
 
@@ -99,6 +99,7 @@ isochroneTime <- function(output.dir,
   for (i in 1:length(time_series)){ # Start loop to calculate journey details
 
     start.time <- Sys.time()
+    stamp <- format(Sys.time(), "%Y_%m_%d_%H_%M_%S") # Windows friendly time stamp
 
     date_time_legend <- format(time_series[i], "%B %d %Y %H:%M") # Creates a legend value for date in day, month, year and time in 24 clock format
     time <- format(time_series[i], "%I:%M %p")
@@ -134,7 +135,7 @@ isochroneTime <- function(output.dir,
     time_df <- data.frame(matrix(, ncol = length(isochroneCutOffs), nrow = nrow(destination_points_spdf))) # Create time dataframe
 
     for (n in 1:length(isochroneCutOffs)){
-      time_df_tmp <- over(destination_points_spdf, isochrone_polygons_split[[n]]) # Finds the polygon the destination point falls within
+      time_df_tmp <- sp::over(destination_points_spdf, isochrone_polygons_split[[n]]) # Finds the polygon the destination point falls within
       time_df[,n] <- time_df_tmp[,2]
     }
 
@@ -208,7 +209,7 @@ isochroneTime <- function(output.dir,
                                                   library = "fa"))
 
 
-    mapview::mapshot(m, file = paste0(output.dir, "/tmp_folder/",gsub(":","",i,ignore.case = TRUE),".png")) # Saves map in temp folder
+    mapview::mapshot(m, file = paste0(output.dir, "/tmp_folder/",stamp,".png")) # Saves map in temp folder
 
     end.time <- Sys.time()
     time.taken[i] <- round(end.time - start.time, digits=2)

diff --git a/propeR/R/otp.R b/propeR/R/otp.R
@@ -292,7 +292,7 @@ otpTripTime <- function(otpcon,
           output_table$to_lat[i] <- df2$to$lat[i]
           output_table$to_lon[i] <- df2$to$lon[i]
           output_table$mode[i] <- df2$mode[i]
-          if (df2$mode[i] == 'CAR' || df2$mode[i] == 'WALK' || df2$mode[i] == 'BICYCLE'){
+          if (df2$mode[i] == 'CAR' || df2$mode[i] == 'WALK' || df2$mode[i] == 'BICYCLE' || df2$mode[i] == 'BICYCLE,WALK'){
             output_table$agencyName[i] <- df2$mode[i]
             output_table$routeShortName[i] <- df2$mode[i]
           } else {
@@ -316,7 +316,11 @@ otpTripTime <- function(otpcon,
               detailed_points[n,"route"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["route"]][[i]]
               detailed_points[n,"distance"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["distance"]][[i]]
               detailed_points[n,"duration"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["duration"]][[i]]
-              detailed_points[n,"agencyName"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["agencyName"]][[i]]
+              if (detailed_points[n,"mode"] == 'CAR' || detailed_points[n,"mode"] == 'WALK' || detailed_points[n,"mode"] == 'BICYCLE'){
+                detailed_points[n,"agencyName"] <- detailed_points[n,"mode"]
+              } else {
+                detailed_points[n,"agencyName"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["agencyName"]][[i]]
+              }
             }
 
           } else {
@@ -330,8 +334,12 @@ otpTripTime <- function(otpcon,
               detailed_points_tmp[n,"route"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["route"]][[i]]
               detailed_points_tmp[n,"distance"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["distance"]][[i]]
               detailed_points_tmp[n,"duration"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["duration"]][[i]]
-              detailed_points_tmp[n,"agencyName"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["agencyName"]][[i]]
-            }
+              if (detailed_points_tmp[n,"mode"] == 'CAR' || detailed_points_tmp[n,"mode"] == 'WALK' || detailed_points_tmp[n,"mode"] == 'BICYCLE'){
+                detailed_points_tmp[n,"agencyName"] <- detailed_points_tmp[n,"mode"]
+              } else {
+                detailed_points_tmp[n,"agencyName"] <- asjson[["plan"]][["itineraries"]][["legs"]][[1]][["agencyName"]][[i]]
+              }
+              }
             detailed_points <- rbind(detailed_points,detailed_points_tmp)
           }
         }

diff --git a/propeR/R/point-to-point-time.R b/propeR/R/point-to-point-time.R
@@ -102,6 +102,7 @@ pointToPointTime <- function(output.dir,
   for (i in 1:length(time_series)){ # Start loop to calculate journey details
 
     start.time <- Sys.time()
+    stamp <- format(Sys.time(), "%Y_%m_%d_%H_%M_%S") # Windows friendly time stamp
 
     date_time_legend <- format(time_series[i], "%d %B %Y %H:%M") # Creates a legend value for date in day, month, year and time in 24 clock format
     time <- format(time_series[i], "%I:%M %p")
@@ -207,7 +208,7 @@ pointToPointTime <- function(output.dir,
                      title = "Date and Time")
     }
 
-    mapview::mapshot(m, file = paste0(output.dir, "/tmp_folder/",gsub(":","",i,ignore.case = TRUE),".png")) # Saves map in temp folder
+    mapview::mapshot(m, file = paste0(output.dir, "/tmp_folder/",stamp,".png")) # Saves map in temp folder
 
     if (i == 1){
       point_to_point_output_table <- point_to_point$itineraries[1,]

diff --git a/propeR/R/point-to-point.R b/propeR/R/point-to-point.R
@@ -52,7 +52,7 @@ pointToPoint <- function(output.dir,
                          arriveBy=F,
                          preWaitTime=60,
                          # colours
-                         transportColours=list(TRANSIT="#000000", WALK="#A14296", BUS="#48C1B1", RAIL="#4D7BC5", CAR="#8D4084", BICYCLE="#4AA6C3"),
+                         transportColours=list(TRANSIT="#000000", WALK="#A14296", BUS="#48C1B1", RAIL="#4D7BC5", CAR="#E825D6", BICYCLE="#4AA6C3"),
                          # leaflet map args
                          mapZoom=12) {
 
@@ -87,7 +87,7 @@ pointToPoint <- function(output.dir,
   start_date <- as.Date(startDateAndTime) # Sets start date
   date_time_legend <- format(as.POSIXct(startDateAndTime), "%d %B %Y %H:%M") # Creates a legend value for date in day, month, year and time in 24 clock format
 
-  point_to_point <- propeR::otpTripTime(
+  point_to_point <- otpTripTime(
     otpcon,
     detail = TRUE, # Gives full breakdown of journey if TRUE
     from = from_origin$lat_lon, # Takes the latitude and longitude from specified origin
@@ -205,17 +205,17 @@ pointToPoint <- function(output.dir,
 
   # Plots leaflet map in Viewer and saves to disk, also saves table as csv ----------
 
-  message("Analysis complete, now saving outputs to ",output.dir,", please wait.\n")  
-
+  # message("Analysis complete, now saving outputs to ",output.dir,", please wait.\n")  
+  # 
   stamp <- format(Sys.time(), "%Y_%m_%d_%H_%M_%S") # Windows friendly time stamp
   invisible(print(m)) # plots map to Viewer
-  mapview::mapshot(m, file = paste0(output.dir, "/p2p-",stamp,".png")) # Saves map to output directory
-  htmlwidgets::saveWidget(m, file = paste0(output.dir, "/p2p-",stamp,".html"), selfcontained = TRUE) # Saves as an interactive HTML webpage
-  unlink(paste0(output.dir,"/p2p-",stamp,"_files"), recursive = TRUE) # Deletes temporary folder created by mapshot
-
+  # mapview::mapshot(m, file = paste0(output.dir, "/p2p-",stamp,".png")) # Saves map to output directory
+  # htmlwidgets::saveWidget(m, file = paste0(output.dir, "/p2p-",stamp,".html"), selfcontained = TRUE) # Saves as an interactive HTML webpage
+  # unlink(paste0(output.dir,"/p2p-",stamp,"_files"), recursive = TRUE) # Deletes temporary folder created by mapshot
+  # 
   write.csv(point_to_point$itineraries[1,], file = paste0(output.dir,"/p2p-",stamp,".csv"),row.names=FALSE) # Saves trip details as a CSV
 
-  unlink(paste0(output.dir,"/tmp_folder"), recursive = TRUE) # Deletes tmp_folder if exists
+  # unlink(paste0(output.dir,"/tmp_folder"), recursive = TRUE) # Deletes tmp_folder if exists
 
-  m
+  point_to_point$itineraries[1,]$duration
 }
diff --git a/propeR/README.md b/propeR/README.md
@@ -39,7 +39,7 @@ Then
 
 ```
 build("propeR_dir")
-install("propeR_dir"")
+install("propeR_dir")
 ```
 
 ## Using