使用光栅 package 下载 SRTM 数据？

Question

我正在尝试使用 R 中的“ raster ”package 获取 SRTM 数据，但是一旦我在 getData 命令中选择SRTM ，就会出现以下错误：

library(raster)

srtm <- getData('SRTM', lon=16, lat=48)
trying URL 'ftp://xftp.jrc.it/pub/srtmV4/tiff/srtm_40_03.zip'
trying URL 'http://hypersphere.telascience.org/elevation/cgiar_srtm_v4/tiff/zip/srtm_40_03.ZIP'
downloaded 572 bytes

Error in .SRTM(..., download = download, path = path) : file not found
In addition: Warning messages:
1: In utils::download.file(url = aurl, destfile = fn, method = "auto",  :
  URL 'ftp://xftp.jrc.it/pub/srtmV4/tiff/srtm_40_03.zip': status was 'Couldn't resolve host name'
2: In utils::unzip(zipfilename, exdir = dirname(zipfilename)) :
  error 1 in extracting from zip file

知道这个错误是什么意思吗？

Answer 1

我有同样的问题，似乎是一个错误。 raster包中的getData函数检查三个不同URL中栅格文件的可用性。

1. ftp://xftp.jrc.it/pub/srtmV4/tiff/FILENAME
2. http://hypersphere.telascience.org/elevation/cgiar_srtm_v4/tiff/zip/FILENAME
3. http://srtm.csi.cgiar.org/SRT-ZIP/SRTM_V41/SRTM_Data_GeoTiff/FILENAME

前两个（截至今天）无法正常工作或无法访问。 但是由于某种原因，一小部分数据正在服务器上传输，因此软件包假定它只是一个可用文件，只能通过utils来解决错误。 然而，第三个网址是三个中最值得信赖的网址之一。

我做了一些挖掘，并在略微修改raster包本身之后提出了以下函数，以便它使用第三个URL。 您可以在此输入Longitude和Latitude值。 请注意，仅当您要根据纬度和经度下载文件时，此功能才有用。

SRTM<-function(lon, lat) {
  stopifnot(lon >= -180 & lon <= 180)
  stopifnot(lat >= -60 & lat <= 60)
  rs <- raster(nrows=24, ncols=72, xmn=-180, xmx=180, ymn=-60, ymx=60 )
  rowTile <- rowFromY(rs, lat)
  colTile <- colFromX(rs, lon)
  if (rowTile < 10) { rowTile <- paste('0', rowTile, sep='') }
  if (colTile < 10) { colTile <- paste('0', colTile, sep='') }

  f <- paste('srtm_', colTile, '_', rowTile, sep="")
  theurl <- paste("http://srtm.csi.cgiar.org/wp-content/uploads/files/srtm_5x5/TIFF/", f, ".ZIP", sep="")
  utils::download.file(url=theurl, destfile='srtm_40_0.zip', method="auto", quiet = FALSE, mode = "wb", cacheOK = TRUE)
}

例：

SRTM(lon=16, lat=48)

这将导致文件夹中名为srtm_40_03.zip的文件通常包含同名的tif ， hdr和tfw文件。 像往常一样使用它们进一步处理。

编辑日期22-JAN-19： srtm链接已更改（以及），上面的代码已经过调整以反映这一点。

Answer 2

尝试使用raster::getData()下载SRTM数据时，我遇到了完全相同的错误。 正如samAct所述，问题与不再可访问的URL有关。

我的解决方案是编辑getData函数，以便首先尝试http://srtm.csi.cgiar.org/SRT-ZIP/SRTM_V41/SRTM_Data_GeoTiff/FILENAME URL。

要使用我编辑的光栅包版本，只需使用`devtools :: install_github（“pokyah / raster”）。 这将覆盖您当前的版本并使getData与有效的URL一起使用。

devtools::install_github("pokyah/raster")
library(raster)

然后，您可以使用此功能下载您感兴趣的区域的SRTM数据：

# @param country_code.chr a character specifying the ISO contrycode. Ex : BE for belgium
# @param NAME_1.chr a character specifying the NAME_1 value for lower than country level information
# @param aggregation_factor.num a numeric specifying the aggregation factor to get the desired spatial resolution
# @param EPSG.chr a character specifying the EPSG code of the desired Coordiante Reference System (CRS)
# @param path.chr a character specifying the path where to dowload the SRTM data

build_highRes_terrain_rasters.fun <- function(country_code.chr, NAME_1.chr=NULL, aggregation_factor.num=NULL, EPSG.chr=NULL, path.chr) {
  # Path to downloaded SRTM Tiles refs
  srtm.tiles.ref <- raster::shapefile("<PATH_TO_DOWNLOADED_TILES_REFS")

  # Get country geometry first
  extent.sp <- raster::getData('GADM', country=country_code.chr, level=1)

  if(!is.null(NAME_1.chr)){
    extent.sp <- subset(extent.sp, NAME_1 == NAME_1.chr)
  }

  # Intersect extent geometry and tile grid
  intersects <- rgeos::gIntersects(extent.sp, srtm.tiles.ref, byid=T)
  tiles      <- srtm.tiles.ref[intersects[,1],]

  # Download tiles using getData
  # inspired from https://www.gis-blog.com/download-srtm-for-an-entire-country/
  srtm_list  <- list()
  for(i in 1:length(tiles)) {
    lon <- extent(tiles[i,])[1]  + (extent(tiles[i,])[2] - extent(tiles[i,])[1]) / 2
    lat <- extent(tiles[i,])[3]  + (extent(tiles[i,])[4] - extent(tiles[i,])[3]) / 2

    tile <- getData('SRTM', #data are downloaded from http://www.cgiar-csi.org/. See getData do of pokyah/raster repo on github
                    lon=lon,
                    lat=lat,
                    download = FALSE,
                    path = path.chr)

    srtm_list[[i]] <- tile
  }

  # Mosaic tiles
  srtm_list$fun <- mean
  srtm_mosaic.ras <- do.call(raster::mosaic, srtm_list)

  # Crop tiles to extent borders
  extent.elevation.ras <- raster::crop(srtm_mosaic.ras, extent.sp)
  extent.elevation.ras <- raster::mask(extent.elevation.ras, extent.sp)

  # transform to desired CRS
  if(!is.null(EPSG.chr)){
    raster::projectRaster(extent.elevation.ras, crs = toString((dplyr::filter(rgdal::make_EPSG(), code==EPSG.chr))$prj4))
  }

  # aggregate to lower resolution
  # inspired from https://stackoverflow.com/questions/32278825/how-to-change-the-resolution-of-a-raster-layer-in-r
  if(!is.null(aggregation_factor.num)){
    extent.elevation.ras <- raster::aggregate(extent.elevation.ras, fact=aggregation_factor.num)
  }

  # compute the slope from the elevation
  # inspired from https://rpubs.com/etiennebr/visualraster
  extent.slope.ras <- raster::terrain(extent.elevation.ras, opt="slope", unit="degrees")
  extent.aspect.ras <- raster::terrain(extent.elevation.ras, opt="aspect", unit="degrees")
  extent.roughness.ras <- raster::terrain(extent.elevation.ras, opt="roughness")

  # compute the aspect from the elevation
  extent.terrain.ras = raster::stack(
    extent.elevation.ras,
    extent.slope.ras,
    extent.aspect.ras,
    extent.roughness.ras)
}

希望能帮助到你 ！

Answer 3

今天，21-01-2019，链接仍然被打破，甚至是由pokyah纠正的那个。 新工作版：

devtools::install_github("fedefyco/raster")
library(raster)

Answer 4

我得到了所有相同的错误，我找到了一个使用httr package 来下载它的解决方案（来源在这里）。

我试过了，但这没有用：

url <- "https://srtm.csi.cgiar.org/wp-content/uploads/files/srtm_5x5/TIFF/srtm_37_04.zip"

library(RCurl)
url2 <- getURL(url)

download.file(url, "test", mode = "auto", method = "curl")
download.file(url, "test", mode = "wb", method = "curl")
download.file(url, "test")
# ... and so on 

library(data.table)
fread(url)

这有效：

library(httr)
httr::set_config(httr::config(ssl_verifypeer=0L))
GET(url, httr::write_disk(path = basename(url), overwrite = TRUE))

为此，我需要更改光栅.download function。 我可以使用R.utils中的reassignInPackage进行最终更改（我认为它是最终的）（ reassignInPackage(name=".download", pkgName="raster", value="my.fn") ）但我更喜欢临时更改。

将其放入您的代码中，它将修复getData function：

y.fn <- function(aurl, filename){
  cat("You wanna download: ", aurl, "\n")
  cat("You wanna save it there : ", filename, "\n\n")
  httr::set_config(httr::config(ssl_verifypeer=0L))
  httr::GET(aurl, httr::write_disk(path = filename, overwrite = TRUE))
}
tmpfun <- get(".download", envir = asNamespace("raster"))
environment(my.fn) <- environment(tmpfun)
attributes(my.fn) <- attributes(tmpfun)  # don't know if this is really needed
assignInNamespace(".download", my.fn, ns="raster")

然后再试一次