Closes #28

r-package/NEWS.md

@@ -8,6 +8,7 @@
 * New function read_population. Closes #21
 * New parameter `peak` added to `read_access()` function. Closes #17
 * New internal support function `is_online()` to alert for possible internet connection problem. Closes #26
+* Chache downloaded data in tempdir. Closes #28
 
 **Minor changes**
 * Downloads two or more cities at the same time. Closes #3.

r-package/R/utils.R

@@ -180,80 +180,113 @@ download_data <- function(file_url, progress_bar = showProgress){
 
   if( !(progress_bar %in% c(T, F)) ){ stop("Value to argument 'showProgress' has to be either TRUE or FALSE") }
 
-## one single file
+  ## one single file
 
-  if(length(file_url)==1 & progress_bar == TRUE){
+  if (length(file_url)==1 & progress_bar == TRUE) {
 
-    # test server connection
-    check_connection(file_url[1])
-
-    # download data
+    # location of temp_file
     temps <- paste0(tempdir(),"/", unlist(lapply(strsplit(file_url,"/"),tail,n=1L)))
-    httr::GET(url=file_url, httr::progress(), httr::write_disk(temps, overwrite = T))
 
-    # load data
-    temp_data <- load_data(file_url, temps)
-    return(temp_data)
+    # check if file has not been downloaded already. If not, download it
+    if (!file.exists(temps)) {
+
+      # test server connection
+      check_connection(file_url[1])
+
+      # download data
+      httr::GET(url=file_url, httr::progress(), httr::write_disk(temps, overwrite = T))
     }
 
-  else if(length(file_url)==1 & progress_bar == FALSE){
+    # load gpkg to memory
+    temp_sf <- load_data(file_url, temps)
+    return(temp_sf)
+  }
 
-    # test server connection
-    check_connection(file_url[1])
+  else if (length(file_url)==1 & progress_bar == FALSE) {
 
-    # download data
+    # location of temp_file
     temps <- paste0(tempdir(),"/", unlist(lapply(strsplit(file_url,"/"),tail,n=1L)))
-    httr::GET(url=file_url, httr::write_disk(temps, overwrite = T))
 
-    # load data
-    temp_data <- load_data(file_url, temps)
-    return(temp_data)
+    # check if file has not been downloaded already. If not, download it
+    if (!file.exists(temps)) {
+
+      # test server connection
+      check_connection(file_url[1])
+
+      # download data
+      httr::GET(url=file_url, httr::progress(), httr::write_disk(temps, overwrite = T))
+    }
+
+    # load gpkg to memory
+    temp_sf <- load_data(file_url, temps)
+    return(temp_sf)
   }
 
-## multiple files
 
-  else if(length(file_url) > 1 & progress_bar == TRUE) {
 
-    # test server connection
-    check_connection(file_url[1])
+  ## multiple files
+
+  else if(length(file_url) > 1 & progress_bar == TRUE) {
 
     # input for progress bar
     total <- length(file_url)
     pb <- utils::txtProgressBar(min = 0, max = total, style = 3)
 
+    # test server connection
+    check_connection(file_url[1])
+
     # download files
     lapply(X=file_url, function(x){
-      i <- match(c(x),file_url)
-      httr::GET(url=x, #httr::progress(),
-                httr::write_disk(paste0(tempdir(),"/", unlist(lapply(strsplit(x,"/"),tail,n=1L))), overwrite = T))
-      utils::setTxtProgressBar(pb, i)})
+
+      # location of temp_file
+      temps <- paste0(tempdir(),"/", unlist(lapply(strsplit(x,"/"),tail,n=1L)))
+
+      # check if file has not been downloaded already. If not, download it
+      if (!file.exists(temps)) {
+        i <- match(c(x),file_url)
+        httr::GET(url=x, #httr::progress(),
+                  httr::write_disk(temps, overwrite = T))
+        utils::setTxtProgressBar(pb, i)
+      }
+    })
 
     # closing progress bar
     close(pb)
 
-    # load data
-    temp_data <- load_data(file_url)
-    return(temp_data)
-    }
+    # load gpkg
+    temp_sf <- load_data(file_url)
+    return(temp_sf)
+
+
+  }
 
   else if(length(file_url) > 1 & progress_bar == FALSE) {
 
     # test server connection
     check_connection(file_url[1])
 
-    # download data
+    # download files
     lapply(X=file_url, function(x){
-      i <- match(c(x),file_url)
-      httr::GET(url=x, #httr::progress(),
-                httr::write_disk(paste0(tempdir(),"/", unlist(lapply(strsplit(x,"/"),tail,n=1L))), overwrite = T))})
 
-    # load data
-    temp_data <- load_data(file_url)
-    return(temp_data)
-    }
-}
+      # location of temp_file
+      temps <- paste0(tempdir(),"/", unlist(lapply(strsplit(x,"/"),tail,n=1L)))
+
+      # check if file has not been downloaded already. If not, download it
+      if (!file.exists(temps)) {
+        i <- match(c(x),file_url)
+        httr::GET(url=x, #httr::progress(),
+                  httr::write_disk(temps, overwrite = T))
+      }
+    })
 
 
+    # load gpkg
+    temp_sf <- load_data(file_url)
+    return(temp_sf)
+
+  }
+}
+
 
 
 #' Load data from tempdir to global environment

r-package/tests/testthat/test_read_access.R

@@ -5,8 +5,13 @@ context("read_access")
   test_that("read_access expected behavior", {
 
     # whole file
-    testthat::expect_output(object = read_access(city='nat', year=2019))
-    testthat::expect_output(object = read_access(city='nat', geometry = TRUE))
+    # testthat::expect_output(object = read_access(city='nat', year=2019))
+    # testthat::expect_output(object = read_access(city='nat', geometry = TRUE))
+
+    expect_true(is(  read_access(city='nat', geometry = TRUE), 'sf'))
+    expect_true(is(  read_access(city='nat', geometry = FALSE), 'data.frame'))
+    expect_true(is(  read_access(city='nat', geometry = FALSE, peak=FALSE), 'data.frame'))
+    expect_true(is(  read_access(city='nat', geometry = FALSE, peak=FALSE, showProgress = FALSE), 'data.frame'))
 
   })
 

r-package/tests/testthat/test_read_grid.R

@@ -5,9 +5,7 @@ context("read_grid")
 test_that("read_grid expected behavior", {
 
   # whole file
-  testthat::expect_output(object = read_grid(city='nat'))
-  # testthat::expect_output(object = read_grid(city='nat', showProgress = FALSE))
-  # testthat::expect_output(object = read_grid(city=c('all')))
+  expect_true(is(  read_grid(city='nat'), 'sf'))
 
 })
 

r-package/tests/testthat/test_read_landuse.R

@@ -5,8 +5,9 @@ context("read_landuse")
   test_that("read_landuse expected behavior", {
 
     # whole file
-    testthat::expect_output(object = read_landuse(city='nat', geometry = TRUE))
-    testthat::expect_output(object = read_landuse(city='nat', geometry = FALSE))
+    expect_true(is(  read_landuse(city='nat', geometry = TRUE), 'sf'))
+    expect_true(is(  read_landuse(city='nat', geometry = FALSE), 'data.frame'))
+    expect_true(is(  read_landuse(city='nat', geometry = FALSE, showProgress = FALSE), 'data.frame'))
   })
 
 ### expected errors and messages ----------------

r-package/tests/testthat/test_read_population.R

@@ -5,8 +5,9 @@ context("read_population")
   test_that("read_population expected behavior", {
 
     # whole file
-    testthat::expect_output(object = read_population(city='nat', geometry = TRUE))
-    testthat::expect_output(object = read_population(city='nat', geometry = FALSE))
+    expect_true(is(  read_population(city='nat', geometry = TRUE), 'sf'))
+    expect_true(is(  read_population(city='nat', geometry = FALSE), 'data.frame'))
+
   })
 
 ### expected errors and messages ----------------