Skip to content

Commit

Permalink
aes
Browse files Browse the repository at this point in the history
  • Loading branch information
Michael Hodge committed Jun 3, 2019
1 parent 1c3b3b9 commit 9824019
Show file tree
Hide file tree
Showing 7 changed files with 280 additions and 170 deletions.
67 changes: 39 additions & 28 deletions propeR/R/isochrone-multi.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@
##' @param isochroneCutOffMax Provide the maximum cutoff time for the isochrone, defaults 90
##' @param isochroneCutOffMin Provide the minimum cutoff time for the isochrone, defaults 10
##' @param isochroneCutOffStep Provide the cutoff time step for the isochrone, 0 denotes no step is required (returns isochroneCutOffMax only), defaults 10
##' @param infoPrint Specifies whether you want some information printed to the console or not, default is TRUE
##' @param mapOutput Specifies whether you want to output a map, defaults to FALSE
##' @param geojsonOutput Specifies whether you want to output a GeoJSON file, defaults to FALSE
##' @param mapZoom The zoom level of the map as an integer (e.g. 12), defaults to bounding box approach
Expand All @@ -38,8 +39,8 @@
##' @param destinationMarkerStroke Specifies whether a destination marker(s) stroke is used (default is T)
##' @param destinationMarkerStrokeColor Specifies the stroke color for the destination marker(s) (default is 'black')
##' @param destinationMarkerStrokeWeight Specifies the marker stroke weight for the destination marker(s) (default is 1)
##' @param destinationMarkerColor Specifies the colour of destination marker(s) if it is not within a isochrone (default is '#00FFAE')
##' @param mapLegendOpacity Specifies the opacity of the legend, defaults to 0.5
##' @param destinationMarkerColor Specifies the colour of destination marker(s) if it is not within a isochrone (default is 'white')
##' @param mapLegendOpacity Specifies the opacity of the legend, defaults to 1
##' @param mapDarkMode Specifies if you want to use the dark leaflet map colour (default is FALSE)
##' @param failSafeSave Specify the failsafe save number for large datasets, default is 100
##' @return Saves journey details as CSV to output directory (optional: a map in PNG and HTML formats, the polygons as a GeoJSON)
Expand Down Expand Up @@ -73,6 +74,7 @@ isochroneMulti <- function(output.dir,
isochroneCutOffMax = 90,
isochroneCutOffMin = 10,
isochroneCutOffStep = 10,
infoPrint = T,
# output args
mapOutput = F,
geojsonOutput = F,
Expand All @@ -90,8 +92,8 @@ isochroneMulti <- function(output.dir,
destinationMarkerStroke = T,
destinationMarkerStrokeColor = 'black',
destinationMarkerStrokeWeight = 1,
destinationMarkerColor = '#00FFAE',
mapLegendOpacity = 0.5,
destinationMarkerColor = 'white',
mapLegendOpacity = 1,
mapDarkMode = F) {

#########################
Expand Down Expand Up @@ -121,11 +123,7 @@ isochroneMulti <- function(output.dir,
isochroneCutOffs <- seq(isochroneCutOffMin, isochroneCutOffMax, isochroneCutOffStep)
}

if (mapDarkMode == T){
mapPolygonColours <- c("#4365BC", "#5776C4", "#6C87CC", "#8098D4", "#95A9DB", "#AABAE3", "#BFCBEA", "#D4DCF1", "#E9EEF8")
} else {
mapPolygonColours <- c("#192448", "#1F2B58", "#243368", "#293B78", "#2E4288", "#334A98", "#3851A8", "#3D58B9", "#4863C3")
}
mapPolygonColours <- c("#4365BC", "#5776C4", "#6C87CC", "#8098D4", "#95A9DB", "#AABAE3", "#BFCBEA", "#D4DCF1", "#E9EEF8")

if (mapOutput == T) {
library(leaflet)
Expand All @@ -143,13 +141,15 @@ isochroneMulti <- function(output.dir,

warning_list <- c()

cat("Now running the propeR isochrone tool.\n")
cat("Parameters chosen:\n")
cat("Date and Time: ", startDateAndTime, "\n", sep = "")
cat("Min Duration (mins): ", isochroneCutOffMin, "\n", sep = "")
cat("Max Duration (mins): ", isochroneCutOffMax, "\n", sep = "")
cat("Isochrone Step (mins): ", isochroneCutOffStep, "\n", sep = "")
cat("Outputs: CSV [TRUE] Map [", mapOutput, "] GeoJSON [", geojsonOutput, "]\n\n", sep = "")
if (infoPrint == T) {
cat("Now running the propeR isochrone tool.\n")
cat("Parameters chosen:\n")
cat("Date and Time: ", startDateAndTime, "\n", sep = "")
cat("Min Duration (mins): ", isochroneCutOffMin, "\n", sep = "")
cat("Max Duration (mins): ", isochroneCutOffMax, "\n", sep = "")
cat("Isochrone Step (mins): ", isochroneCutOffStep, "\n", sep = "")
cat("Outputs: CSV [TRUE] Map [", mapOutput, "] GeoJSON [", geojsonOutput, "]\n\n", sep = "")
}

###########################
#### CALL OTP FUNCTION ####
Expand All @@ -162,11 +162,15 @@ isochroneMulti <- function(output.dir,
time.taken <- vector()
originPoints_removed <- c()
originPoints_removed_list <- c()
message("Creating ", num.total, " isochrones, please wait...")
if (infoPrint == T) {
message("Creating ", num.total, " isochrones, please wait...")
}

pb <- progress_bar$new(
format = " Isochrone calculation complete for call :what [:bar] :percent eta: :eta",
total = num.total, clear = FALSE, width= 100)
if (infoPrint == T) {
pb <- progress::progress_bar$new(
format = " Isochrone calculation complete for call :what [:bar] :percent eta: :eta",
total = num.total, clear = FALSE, width= 100)
}

for (i in num.start:num.end) {
num.run <- num.run + 1
Expand Down Expand Up @@ -303,7 +307,9 @@ isochroneMulti <- function(output.dir,

isochrone_polygons@plotOrder <- tmp_seq

pb$tick(tokens = list(what = num.run))
if (infoPrint == T) {
pb$tick(tokens = list(what = num.run))
}

if ((num.run/failSafeSave) %% 1 == 0) { # fail safe for large files
is.na(time_df) <- sapply(time_df, is.infinite)
Expand Down Expand Up @@ -359,7 +365,7 @@ isochroneMulti <- function(output.dir,
m <- addScaleBar(m)

if (mapDarkMode != T) {
m <- addProviderTiles(m, providers$OpenStreetMap.BlackAndWhite)
m <- addProviderTiles(m, providers$CartoDB.Positron)
} else {
m <- addProviderTiles(m, providers$CartoDB.DarkMatter)
}
Expand Down Expand Up @@ -427,13 +433,16 @@ isochroneMulti <- function(output.dir,
######################
#### SAVE RESULTS ####
######################

cat("Analysis complete, now saving outputs to ", output.dir, ", please wait.\n", sep = "")
cat("Journey details:\n", sep = "")
cat("Isochrones generated: ", num.total-length(originPoints_removed_list),"/",num.total,"\n", sep = "")

is.na(time_df) <- sapply(time_df, is.infinite)


if (infoPrint == T) {
cat("Analysis complete, now saving outputs to ", output.dir, ", please wait.\n", sep = "")
cat("Journey details:\n", sep = "")
cat("Isochrones generated: ", num.total-length(originPoints_removed_list),"/",num.total,"\n", sep = "")
cat("Destinations possible: ", ncol(time_df) - sum(colSums(is.na(time_df)) == nrow(time_df)),"/",ncol(time_df),"\n", sep = "")
}

write.csv(
time_df,
file = paste0(output.dir, "/isochroneMulti-", file_name, "/csv/isochroneMulti-isochrone_multi_inc-", file_name, ".csv"),
Expand Down Expand Up @@ -468,5 +477,7 @@ isochroneMulti <- function(output.dir,
unlink(paste0(output.dir, "/isochroneMulti-", file_name, "/map/isochroneMulti-", file_name, "_files"), recursive = T)
}

cat("Outputs saved. Thanks for using propeR.\n")
if (infoPrint == T) {
cat("Outputs saved. Thanks for using propeR.\n")
}
}
68 changes: 39 additions & 29 deletions propeR/R/isochrone-time.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@
##' @param isochroneCutOffMax Provide the maximum cutoff time for the isochrone, defaults 90
##' @param isochroneCutOffMin Provide the minimum cutoff time for the isochrone, defaults 10
##' @param isochroneCutOffStep Provide the cutoff time step for the isochrone, defaults 10
##' @param infoPrint Specifies whether you want some information printed to the console or not, default is TRUE
##' @param gifOutput Specifies whether you want to output a gif, defaults to FALSE
##' @param mapOutput Specifies whether you want to output the maps, defaults to FALSE
##' @param geojsonOutput Specifies whether you want to output a GeoJSON file, defaults to FALSE
Expand All @@ -44,9 +45,9 @@
##' @param destinationMarkerStroke Specifies whether a destination marker(s) stroke is used (default is T)
##' @param destinationMarkerStrokeColor Specifies the stroke color for the destination marker(s) (default is 'black')
##' @param destinationMarkerStrokeWeight Specifies the marker stroke weight for the destination marker(s) (default is 1)
##' @param destinationMarkerInColor Specifies the colour of destination marker(s)if it is within a isochrone (default is '#00FFAE')
##' @param destinationMarkerOutColor Specifies the colour of destination marker(s) if it is not within a isochrone (default is '#FF00E0')
##' @param mapLegendOpacity Specifies the opacity of the legend, defaults to 0.5
##' @param destinationMarkerInColor Specifies the colour of destination marker(s)if it is within a isochrone (default is 'white')
##' @param destinationMarkerOutColor Specifies the colour of destination marker(s) if it is not within a isochrone (default is 'grey')
##' @param mapLegendOpacity Specifies the opacity of the legend, defaults to 1
##' @param mapDarkMode Specifies if you want to use the dark leaflet map colour (default is FALSE)
##' @return Saves journey details as comma separated value file to output directory. An animated map in .gif format may also be saved.
##' @author Michael Hodge
Expand Down Expand Up @@ -84,6 +85,7 @@ isochroneTime <- function(output.dir,
isochroneCutOffMax = 90,
isochroneCutOffMin = 10,
isochroneCutOffStep = 10,
infoPrint = T,
# leaflet map args
gifOutput = F,
mapOutput = F,
Expand All @@ -102,9 +104,9 @@ isochroneTime <- function(output.dir,
destinationMarkerStroke = T,
destinationMarkerStrokeColor = 'black',
destinationMarkerStrokeWeight = 1,
destinationMarkerInColor = '#00FFAE',
destinationMarkerOutColor = '#FF00E0',
mapLegendOpacity = 0.5,
destinationMarkerInColor = 'white',
destinationMarkerOutColor = 'grey',
mapLegendOpacity = 1,
mapDarkMode = F) {

#########################
Expand Down Expand Up @@ -141,11 +143,7 @@ isochroneTime <- function(output.dir,
isochroneCutOffs <- seq(isochroneCutOffMin, isochroneCutOffMax, isochroneCutOffStep)
}

if (mapDarkMode == T){
mapPolygonColours <- c("#4365BC", "#5776C4", "#6C87CC", "#8098D4", "#95A9DB", "#AABAE3", "#BFCBEA", "#D4DCF1", "#E9EEF8")
} else {
mapPolygonColours <- c("#192448", "#1F2B58", "#243368", "#293B78", "#2E4288", "#334A98", "#3851A8", "#3D58B9", "#4863C3")
}
mapPolygonColours <- c("#4365BC", "#5776C4", "#6C87CC", "#8098D4", "#95A9DB", "#AABAE3", "#BFCBEA", "#D4DCF1", "#E9EEF8")

if (gifOutput == T || mapOutput == T) {
library(leaflet)
Expand All @@ -167,15 +165,17 @@ isochroneTime <- function(output.dir,

warning_list <- c()

cat("Now running the propeR pointToPointTime tool.\n", sep="")
cat("Parameters chosen:\n", sep="")
cat("From: ", from_origin$name, " (", from_origin$lat_lon, ")\n", sep="")
cat("Date and Time: ", startDateAndTime, " (start) to ", endDateAndTime, " (end)\n", sep="")
cat("Intervals (mins): ", timeIncrease, "\n", sep="")
cat("Min Duration (mins): ", isochroneCutOffMin, "\n", sep = "")
cat("Max Duration (mins): ", isochroneCutOffMax, "\n", sep = "")
cat("Isochrone Step (mins): ", isochroneCutOffStep, "\n", sep = "")
cat("Outputs: CSV [TRUE] Map [", mapOutput, "] GeoJSON [", geojsonOutput, "] GIF [", gifOutput, "]\n\n", sep="")
if (infoPrint == T) {
cat("Now running the propeR pointToPointTime tool.\n", sep="")
cat("Parameters chosen:\n", sep="")
cat("From: ", from_origin$name, " (", from_origin$lat_lon, ")\n", sep="")
cat("Date and Time: ", startDateAndTime, " (start) to ", endDateAndTime, " (end)\n", sep="")
cat("Intervals (mins): ", timeIncrease, "\n", sep="")
cat("Min Duration (mins): ", isochroneCutOffMin, "\n", sep = "")
cat("Max Duration (mins): ", isochroneCutOffMax, "\n", sep = "")
cat("Isochrone Step (mins): ", isochroneCutOffStep, "\n", sep = "")
cat("Outputs: CSV [TRUE] Map [", mapOutput, "] GeoJSON [", geojsonOutput, "] GIF [", gifOutput, "]\n\n", sep="")
}

###########################
#### CALL OTP FUNCTION ####
Expand All @@ -186,11 +186,15 @@ isochroneTime <- function(output.dir,
num.run <- 0
num.total <- num.end
time.taken <- vector()
cat("Creating ", num.total, " isochrone connections, please wait...\n", sep="")
if (infoPrint == T) {
cat("Creating ", num.total, " isochrone connections, please wait...\n", sep="")
}

pb <- progress_bar$new(
format = " Isochrone calculation complete for time :what [:bar] :percent eta: :eta",
total = num.total, clear = FALSE, width= 100)
if (infoPrint == T) {
pb <- progress::progress_bar$new(
format = " Isochrone calculation complete for time :what [:bar] :percent eta: :eta",
total = num.total, clear = FALSE, width= 100)
}

for (i in num.start:num.total) {
num.run <- num.run + 1
Expand Down Expand Up @@ -273,7 +277,7 @@ isochroneTime <- function(output.dir,
m <- addScaleBar(m)

if (mapDarkMode != T) {
m <- addProviderTiles(m, providers$OpenStreetMap.BlackAndWhite)
m <- addProviderTiles(m, providers$CartoDB.Positron)
} else {
m <- addProviderTiles(m, providers$CartoDB.DarkMatter)
}
Expand Down Expand Up @@ -372,15 +376,19 @@ isochroneTime <- function(output.dir,
driver = "GeoJSON")
}

pb$tick(tokens = list(what = time))
if (infoPrint == T) {
pb$tick(tokens = list(what = time))
}

}

######################
#### SAVE RESULTS ####
######################

cat("\nAnalysis complete, now saving outputs to ", output.dir, ", please wait.\n", sep="")
if (infoPrint == T) {
cat("\nAnalysis complete, now saving outputs to ", output.dir, ", please wait.\n", sep="")
}

write.csv(
destination_points_output,
Expand Down Expand Up @@ -408,10 +416,12 @@ isochroneTime <- function(output.dir,

m <-
magick::image_read(paste0(output.dir, "/isochroneTime-", file_name, "/gif/", "/isochroneTime-gif-", file_name, ".gif")) %>%
magick::image_scale("600") # Loads GIF into R
magick::image_scale("800") # Loads GIF into R

invisible(print(m)) # plots map to Viewer
}

cat("Outputs saved. Thanks for using propeR.\n")
if (infoPrint == T) {
cat("Outputs saved. Thanks for using propeR.\n")
}
}
Loading

0 comments on commit 9824019

Please sign in to comment.