R/writeCache.R

In pik-piam/geodata: Landuse geodata library

#' @importFrom raster writeRaster
## function to write to cache

## to do:
# if there is res in the args, but length == 1 then dublicate it
# it there is rast specified, do not just take the name of it but rather read the proj, etc.? But this is somehow against the general concept of just taking the arguments

writeCache <- function(x) {
  
  # use the arguments of the original function as file name (e.g. 0.5_0.5 for the resolution)
  arg <- names(as.list(sys.function(1))[-length(as.list(sys.function(1)))])
  arg <- arg[!arg %in% c("rCache", "wCache")]
  filename <- paste(as.list(sys.frame(1))[arg], collapse="_")

  ## get the name of the original function (e.g. readFF); = the last but one sys.call
#  funcname <- paste(sys.call(1)[1])
#  funcname <- strsplit(paste0(tail(sys.calls(),n = 2)[[1]]),"(",fixed = T)[[1]]
  funcname <- strsplit(as.character(rev(sys.calls())[[2]]), split = "(", fixed=T)[[1]]
   
  # the filename is constructed out of these
  filedir <- paste0(geodata$config$mainfolder, "/cache/", funcname, "/")

  dir.create(filedir, showWarnings = FALSE)
  
  # write the result to the cache
  if (class(x)=="RasterLayer") {
    print(paste0("Writing cache file to: ", filedir,filename, ".tif"))
    writeRaster(x, paste0(filedir,filename, ".tif"), overwrite=TRUE)
  } else if (class(x) == "SpatialPolygonsDataFrame") {
#    print(paste0("Writing cache file to: ", filedir,filename, ".shp"))
#    rgdal::writeOGR(x, dsn=paste0(filedir,filename, ".shp"), layer=filename, driver="ESRI Shapefile", overwrite_layer = TRUE)
    ## try to save as rda instead
    print(paste0("Writing cache file to: ", filedir,filename, ".rda"))
    save(x, file = paste0(filedir,filename, ".rda"), compress = "gzip")
  }

}




### general structure seems ok

# testfun <- function () {
#   as.list(sys.function(1))[-length(as.list(sys.function(1)))]
# }
# 
# testfun2 <- function () {
# #  funcname <- paste(sys.call(1))
# #  funcname <- strsplit(paste0(tail(sys.calls(),n = 2)[[1]]),"(",fixed = T)#[[1]]
# #  funcname <- gsub("([a-z]*)\\(","\\1",rev(sys.calls())[[2]])
#   funcname <- strsplit(as.character(rev(sys.calls())[[2]]), split = "(", fixed=T)[[1]]
# }
# 
# rapfunc <- function(dat, a=5, b=2) {
#   bla <- "XX"
#   y <- testfun2()
#   y
# }
# 
# rapfunc(a=10)
# 
# do.call(paste0("rap","func"), args=list(a=10))

## sollte vorletztes element verwenden.