Remove data from package

NAMESPACE

@@ -26,8 +26,10 @@ export(importFLF)
 export(importMCA)
 export(importMSN)
 export(importTSI)
+export(load_data)
 export(nptdr2gtfs)
 export(nr2gtfs)
 export(station2stops)
 export(transxchange2gtfs)
 export(transxchange_import)
+export(update_data)

R/atoc.R

@@ -45,6 +45,10 @@ atoc2gtfs <- function(path_in,
                       shapes = FALSE,
                       transfers = TRUE,
                       missing_tiplocs = TRUE) {
+
+  load_data("tiplocs")
+  load_data("atoc_agency")
+
   # Checkmates
   checkmate::assert_character(path_in, len = 1)
   checkmate::assert_file_exists(path_in)

R/atoc_nr.R

@@ -38,6 +38,10 @@ nr2gtfs <- function(path_in,
                       locations = tiplocs,
                       agency = atoc_agency,
                       shapes = FALSE) {
+
+  load_data("tiplocs")
+  load_data("atoc_agency")
+
   # checkmate
   checkmate::assert_character(path_in, len = 1)
   checkmate::assert_file_exists(path_in)
@@ -65,7 +69,6 @@ nr2gtfs <- function(path_in,
 
   # Get the Station Locations
   if ("sf" %in% class(locations)) {
-    # load("data/tiplocs.RData")
     stops <- cbind(locations, sf::st_coordinates(locations))
     stops <- as.data.frame(stops)
     stops <- stops[, c(

R/atoc_shapes.R

@@ -16,7 +16,7 @@ ATOC_shapes <- function(gtfs) {
 
   # Make Graph of Railway
   # rail <- rail
-  rail_heavy <- rail_heavy
+  load_data("rail_heavy")
   rail_heavy$type <- "rail"
   # rail_light <- rail[rail$type == "light_rail", ]
   wts <- c(1)

R/data.R

@@ -1,18 +1,3 @@
-#' Agency.txt for ATOC data
-#'
-#' The ATOC data does not included sufficient information to build agency.txt
-#' So this data is provided in the package.
-#'
-#' @format A data frame
-"atoc_agency"
-
-#' Tiploc Locations
-#'
-#' The ATOC data has inaccurate locations for many tiplocs, this is an improved dataset
-#'
-#' @format A SF data frame for points
-"tiplocs"
-
 #' Activity Codes
 #'
 #' ATOC activity codes matched to GTFS pickup_type and drop_off_type values.
@@ -28,69 +13,6 @@
 #' @format A data frame code 3 columns
 "activity_codes"
 
-#' Bus Stop Locations missing from NapTAN
-#'
-#' A database of bus stops that are missing from the NAPTAN but are known to
-#' have been used. For some reason the offical NAPTAN file is missing a small
-#' number of bus stops. This file contains a selection of bus stops that have
-#' appears in TransXchange files, but are missing in the NAPTAN. The have been
-#' assembled from a range of sources and may be of varying quality.
-#'
-#' In some cases the name of the Bus Stop has been ideitifed but not the location.
-#'
-#' @format A data frame of 5 columns
-"naptan_missing"
-
-#' Bus Stop Locations wrong in the NaPTAN
-#'
-#' A database of bus stops that are wrong in the NAPTAN. These have been
-#' corrected with a mix of manual and automatic techniques. Contributions are
-#' welcome of improved locations.
-#'
-#'
-#' @format A data frame of 5 columns
-"naptan_replace"
-
-
-#' Rail Network
-#'
-#' A simplified version of the UK rail network.
-#'
-#'
-#' @format A SF data frame
-"rail"
-
-#' Heavy Rail Network
-#'
-#' A simplified version of the UK heavy rail network.
-#'
-#'
-#' @format A SF data frame
-"rail_heavy"
-
-#' ATCO Admin Areas
-#'
-#' Association of Transport Co-ordinating Officers Code
-#'
-#' Boundaries of the ATCO Admin Areas. Note there are 4 national areas
-#' represented by a box around the UK.
-#'
-#'
-#' @format A SF data frame
-"atco_areas"
-
-
-
-#' Historic Bank Holidays
-#'
-#' Bank holidays from 2001 to 2018 in the UK. Note Wales has the same holidays
-#' as England.
-#'
-#'
-#' @format A data frame with 4 columns
-"historic_bank_holidays"
-
-
 #' Example School term and holiday dates
 #'
 #' Term dates change around the UK and from year to year. This are simply the

R/extdata.R

@@ -0,0 +1,164 @@
+#' Update the data inside the UK2GTFS package
+#'
+#' As UK2GTFS has large datasets that update separately to the R package they
+#' are checked and downloaded at package load time. This function checks for and
+#' downloaded any updated to the data.
+#'
+#' Raw data can be viewed and contributed to at
+#' https://github.com/ITSLeeds/UK2GTFS-data
+#'
+#' @export
+#'
+update_data <- function(){
+
+  check <- check_data()
+
+  if(check$date_package != check$date){
+
+    if (interactive()) {
+
+      response <- readline("UK2GTFS data is out of date. Do you want to update? (yes/no): ")
+      response <- tolower(response)
+
+      if (response == "yes" || response == "y") {
+        message("Updating internal package data")
+        download_data(check$tag_name, check$package_location, check$date)
+      } else if (response == "no" || response == "n") {
+        cat("You can rerun this check with update_data()")
+      } else {
+        cat("Invalid response.\n")
+      }
+
+
+    } else {
+      message("Data not updated, run update_data()")
+      #message("Updating internal package data")
+      #download_data(check$tag_name, check$package_location, check$date)
+    }
+
+  } else {
+    message("Your UK2GTFS data is up to date")
+  }
+
+}
+
+#' Update the data inside the UK2GTFS package
+#'
+#' As UK2GTFS has large datasets that update separately to the R package they
+#' are checked and downloaded a package load time
+#'
+#' @noRd
+#'
+download_data <- function(tag_name, package_location, date){
+
+  dir.create(file.path(tempdir(),"UK2GTFS_load"))
+  download.file(paste0("https://github.com/ITSLeeds/UK2GTFS-data/releases/download/",
+                       tag_name,"/all.zip"),
+                destfile = file.path(tempdir(),"UK2GTFS_load/all.zip"),
+                mode = "wb")
+  utils::unzip(file.path(tempdir(),"UK2GTFS_load/all.zip"),
+               exdir = file.path(package_location, "extdata"))
+  unlink(file.path(tempdir(),"UK2GTFS_load"), recursive = TRUE)
+  writeLines(date, file.path(package_location, "extdata/date.txt"))
+
+}
+
+
+#' Check if data in package is up to date
+#'
+#' As UK2GTFS has large datasets that update separately to the R package they
+#' are checked and downloaded a package load time
+#' @return TRUE if data is up-to-date or if unable to check
+#' @noRd
+
+check_data <- function(){
+  # Check date on data repo
+  res = try(httr::GET("https://api.github.com/repos/ITSleeds/UK2GTFS-data/releases"),
+            silent = TRUE)
+  if(inherits(res, "try-error")){
+    message("Unable to check for latest data")
+    return(TRUE)
+  }
+
+  res = RcppSimdJson::fparse(res$content)
+  date = res$published_at[1]
+  tag_name = res$tag_name[1]
+
+  #Check if date.txt in package
+  package_location <- system.file(package = "UK2GTFS")
+  if(!file.exists(file.path(package_location, "extdata/date.txt"))){
+    writeLines("nodata", file.path(package_location, "extdata/date.txt"))
+  }
+
+  date_package <- readLines(file.path(package_location, "extdata/date.txt"))
+
+  return(list(date_package = date_package, date = date, tag_name = tag_name,
+              package_location = package_location))
+}
+
+#' Load a built-in UK2GTFS dataset
+#'
+#' As UK2GTFS has large datasets that update separately to the R package they
+#' are checked and downloaded at package load time.
+#'
+#' This function loads a dataset. Examples are:
+#'
+#'
+#' "atco_areas" ATCO Admin Areas
+#'
+#' Association of Transport Coordinating Officers
+#'
+#' Boundaries of the ATCO Admin Areas. Note there are 4 national areas
+#' represented by a box around the UK.
+#'
+#' "atoc_agency" Agency.txt for ATOC data
+#'
+#' The ATOC data does not included sufficient information to build agency.txt
+#' So this data is provided in the package.
+#'
+#' "tiplocs" Tiploc Locations
+#'
+#' The ATOC data has inaccurate locations for many tiplocs, this is an improved dataset
+#'
+#' "naptan_missing" Bus Stop Locations missing from NapTAN
+#'
+#' A database of bus stops that are missing from the NAPTAN but are known to
+#' have been used. For some reason the official NAPTAN file is missing a small
+#' number of bus stops. This file contains a selection of bus stops that have
+#' appears in TransXchange files, but are missing in the NAPTAN. The have been
+#' assembled from a range of sources and may be of varying quality.
+#'
+#' In some cases the name of the Bus Stop has been identified but not the location.
+#'
+#' "naptan_replace" Bus Stop Locations wrong in the NaPTAN
+#'
+#' A database of bus stops that are wrong in the NAPTAN. These have been
+#' corrected with a mix of manual and automatic techniques. Contributions are
+#' welcome of improved locations.
+#'
+#' "rail_light" Light Rail Network
+#'
+#' A simplified version of the UK light rail network.
+#'
+#' "rail_heavy" Heavy Rail Network
+#'
+#' A simplified version of the UK heavy rail network.
+#'
+#' "historic_bank_holidays" Historic Bank Holidays
+#'
+#' Bank holidays from 2001 to 2018 in the UK. Note Wales has the same holidays
+#' as England.
+#'
+#'
+#' @param type name of data to be loaded e.g. "tiplocs"
+#' @return Loads named object into the global environment
+#' @export
+
+load_data <- function(type){
+
+  package_location <- system.file(package = "UK2GTFS")
+  load(file.path(package_location, "extdata", paste0(type,".rda")),
+       envir = globalenv())
+
+}
+

R/get_naptan.R

@@ -13,7 +13,10 @@
 #'
 #' @export
 
-get_naptan <- function(url = "https://naptan.api.dft.gov.uk/v1/access-nodes?dataFormat=csv", naptan_extra = naptan_missing) {
+get_naptan <- function(url = "https://naptan.api.dft.gov.uk/v1/access-nodes?dataFormat=csv",
+                       naptan_extra = naptan_missing) {
+
+  load_data("naptan_missing")
 
   dir.create("temp_naptan")
   utils::download.file(url = url, destfile = "temp_naptan/Stops.csv", mode = "wb", quiet = TRUE)

R/zzz.R

@@ -0,0 +1,6 @@
+# Run when package loads
+.onLoad <- function(libname, pkgname){
+  update_data()
+}
+
+

inst/extdata/date.txt

@@ -0,0 +1 @@
+nodata