diff --git a/propeR/DESCRIPTION b/propeR/DESCRIPTION index 27ddd87..1c9ee80 100644 --- a/propeR/DESCRIPTION +++ b/propeR/DESCRIPTION @@ -11,6 +11,8 @@ Authors@R: c( person("Michael", "Hodge", email = "michael.hodge@ons.gov.uk", role = c("aut", "cre")), person("Phil", "Stubbings", email = "philip.stubbings@ons.gov.uk", + role = c("ctb")), + person("Ioannis", "Tsalamanis", email = "ioannis.tsalamanis@ons.gov.uk", 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 index 08d4342..402f2d1 100644 --- 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 index 344d86b..ba357dd 100644 --- 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 index 881a1b1..69e5a13 100644 --- 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 index d9ae588..a708a92 100644 --- 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 index 708e5e3..36d5124 100644 --- 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 } \ No newline at end of file diff --git a/propeR/README.md b/propeR/README.md index 26a9e1b..088a263 100644 --- a/propeR/README.md +++ b/propeR/README.md @@ -39,7 +39,7 @@ Then ``` build("propeR_dir") -install("propeR_dir"") +install("propeR_dir") ``` ## Using