【问题标题】:How can I create an R loop with the code provided below?如何使用下面提供的代码创建 R 循环?
【发布时间】:2021-04-29 12:51:00
【问题描述】:

请,我需要帮助来创建一个循环,该循环将在 R 中包含 483 个文件的 hdflist 上执行以下代码中所示的计算。我添加了一个包含两个 .hdf 文件和用于试用的 shapefile 的链接。该代码似乎适用于单个 .hdf 文件,但我仍在努力循环。谢谢

download files from here https://beardatashare.bham.ac.uk/getlink/fi2gNzWbuv5H8Gp7Qg2aemdM/

# import .hdf file into R using get_subdatasets to access the subsets in the file`
sub <- get_subdatasets("MOD13Q1.A2020353.h18v08.006.2021003223721.hdf")

# convert red and NIR subsets and save them as raster`
gdalwarp(sub[4], 'red_c.tif')
gdalwarp(sub[5], 'NIR_c.tif')

# import red and NIR raster back into R`
# scale the rater while at it`

r_r=raster('red_c.tif') * 0.0001 
r_N=raster('NIR_c.tif') * 0.0001 

# calculate sigma using (0.5*(NIR+red))`
sigma <- (0.5*(r_N+r_r))

# calculate knr using exp((-(NIR-red)^2)/(2*sigma^2))`
knr <- exp((-(r_N-r_r)^2)/(2*sigma^2))

# calculate kndvi using (1 - knr) / (1 + knr)`
kndvi <- (1 - knr) / (1 + knr)

# import shapefile into R`
shp=readOGR(".", "National_Parks")
options(stringsAsFactors = FALSE)

#change crs of shapefile to crs of one of the rasters`
shp2 <- spTransform(shp, crs(kndvi))

# use extent to crop/clip raster`
## set extent`
e <- extent(910000,980000, 530000, 650000)

## clip using crop function`

crop_kndvi <- crop(kndvi, e)

# mask raster using the shapefile`
kndvi_mask <- mask(crop_kndvi, shp2)

然后将 kndvi_mask 保存为 483 个文件的光栅

【问题讨论】:

    标签: r loops raster hdf


    【解决方案1】:

    以下是使用terra 的方法。 terraraster 的替代品;它更快,更通用。例如,使用terra,您可以跳过gdalwarp 步骤。

    你可以写一个大的for-loop,但我更喜欢使用函数,然后在循环中调用它们或lapply

    此外,将kndvi 计算包装到自己的函数中并将其与lapp 一起使用可能更有效,而不是您的光栅代数方法。我认为这是一种更好的方法,因为代码更清晰,它允许您重复使用 kndvi 函数。

    library(terra)
    parks <- vect("National_Parks.shp")
    parks <- project(parks, "+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +R=6371007.181 +units=m")
    e <- ext(910000,980000, 530000, 650000)
    

    lapp使用的kndvi函数

    kndvi <- function(red, NIR) {
        red <- red * 0.0001 
        NIR <- NIR * 0.0001 
        sigma <- (0.5 * (NIR + red))
        knr <- exp((-(NIR-red)^2)/(2*sigma^2))
        (1 - knr) / (1 + knr)
    }
    

    主要功能。请注意,我使用crop before 其他功能;这节省了很多不必要的处理。

    fun <- function(f) {
        outf <- gsub(".hdf$", "_processed.tif", f) 
        # if file.exists(outf) return(rast(outf))
        r <- rast(f)[[4:5]]
        # or r <- sds(f)[4:5]
        r <- crop(r, e)
        kn <- lapp(r, kndvi)
        name <- substr(basename(f), 9, 16)
        mask(kn, parks, filename=outf, overwrite=TRUE, names=name)
    }
    

    获取文件名并通过循环或lapply 使用函数,如 Elia 所示。

    ff <- list.files(pattern="hdf$", full=TRUE)
    
    x <- list()
    for (i in 1:length(ff)) {
        print(ff[i]); flush.console()
        x[[i]] <- fun(ff[i])
    }
    z <- rast(x)
    z
    
    #class       : SpatRaster 
    #dimensions  : 518, 302, 2  (nrow, ncol, nlyr)
    #resolution  : 231.6564, 231.6564  (x, y)
    #extent      : 909946.2, 979906.4, 530029.7, 650027.7  (xmin, xmax, ymin, ymax)
    #coord. ref. : +proj=sinu +lon_0=0 +x_0=0 +y_0=0 +R=6371007.181 +units=m +no_defs 
    #sources     : MOD13Q1.A2020337.h18v08.006.2020358165204_processed.tif  
    #              MOD13Q1.A2020353.h18v08.006.2021003223721_processed.tif  
    #names       :     A2020337,     A2020353 
    #min values  : 0.0007564131, 0.0028829363 
    #max values  :    0.7608207,    0.7303495
    

    在我的计算机上,每个文件大约需要 1 秒。

    或作为您要求的for-loop

    ff <- list.files(pattern="hdf$", full=TRUE)
    for (f in ff) {
        print(f); flush.console()
        outf <- gsub(".hdf$", "_processed.tif", f) 
        r <- rast(f)[[4:5]]
        r <- crop(r, e)
        kn <- lapp(r, kndvi)
        name <- substr(basename(f), 9, 16)
        mask(kn, parks, filename=outf, overwrite=TRUE, names=name)
    }
    
    outf <- list.files(pattern="_processed.tif$", full=TRUE)
    x <- rast(outf)
    

    【讨论】:

    • 谢谢@罗伯特。您的解决方案效果很好。
    • 处理速度惊人,节省了整个CPU处理内存和时间。再次感谢您。
    【解决方案2】:

    您可以将代码包装在一个函数中,然后在 hdf 路径上使用lapply。这样,如果您的循环太慢,将很容易并行化它。 你可以试试这个:

    library(gdalUtils)
    library(raster)
    library(rgdal)
    #set the directory where you have .hdf files. In my case I downloaded your data in "D:/download"
    setwd("D:/download")
    #function to save the masked index in your current working directory
    #the final files name will depend on the name of the input hdf files
    myfun <- function(path){
      name <- basename(tools::file_path_sans_ext(path))
      sub <- get_subdatasets(path)
      gdalwarp(sub[4], paste0(name,'_red_c.tif'))
      gdalwarp(sub[5], paste0(name,'NIR_c.tif'))
      r_r=raster(paste0(name,'_red_c.tif')) * 0.0001 
      r_N=raster(paste0(name,'NIR_c.tif')) * 0.0001 
      
      sigma <- (0.5*(r_N+r_r))
      knr <- exp((-(r_N-r_r)^2)/(2*sigma^2))
      kndvi <- (1 - knr) / (1 + knr)
      crop_kndvi <- crop(kndvi, e)
      kndvi_mask <- mask(crop_kndvi, 
      shp2,filename=paste0(name,"_kndvi_mask.tif"))
    }
    
    
    
        #list the hdf file in your current working directory. Thanks to setwd("D:/download") there is no need to specify the path argument of list.files().
       b#however for the for peace of mind:
        hdf <- list.files(path=getwd(),pattern = "hdf",full.names = T)
        #since your shop is always the same you could keep this part out of the function
        shp=readOGR(".", "National_Parks")
        options(stringsAsFactors = FALSE)
        shp2 <- spTransform(shp,  "+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m
                            +no_defs ")
        e <- extent(910000,980000, 530000, 650000)
        #now run your function across the hdf files path
        lapply(hdf, myfun)
    

    现在在您的工作目录中,您可以找到所有保存的 if

       list.files(pattern = "tif")
    [1] "MOD13Q1.A2020337.h18v08.006.2020358165204_kndvi_mask.tif"
    [2] "MOD13Q1.A2020337.h18v08.006.2020358165204_red_c.tif"     
    [3] "MOD13Q1.A2020337.h18v08.006.2020358165204NIR_c.tif"      
    [4] "MOD13Q1.A2020353.h18v08.006.2021003223721_kndvi_mask.tif"
    [5] "MOD13Q1.A2020353.h18v08.006.2021003223721_red_c.tif"     
    [6] "MOD13Q1.A2020353.h18v08.006.2021003223721NIR_c.tif"
    

    在我的电脑上使用lapply,该功能在 45 秒内运行。 例如,您可以通过将 sfLapply 替换为 snowfall 包中的 sfLapply 来轻松并行化 lapply。仅仅 2 个文件是不值得的,但如果你有数百个文件,你可以大大加快这个过程:

    library(snowfall)
    
    #open cluster with as many node as hdf file
    sfInit(parallel=TRUE, cpus=length(hdf))
    # Load the required packages inside the cluster
    sfLibrary(raster)
    sfLibrary(rgdal)
    sfLibrary(gdalUtils)
    sfExportAll()
    system.time(sfLapply(hdf, myfun))
    sfStop()
    

    使用sfLapply,此函数需要 20 秒才能运行。这是一个很好的改进

    【讨论】:

    • 谢谢。我已经尝试过了,但我不断收到错误消息。此外,我似乎无法找到您在哪里应用了“e”程度如何应用于流程。 Error in .rasterObjectFromFile(x, band = band, objecttype = "RasterLayer", : Cannot create a RasterLayer object from this file. (file does not exist)
    • 我认为这是目录和文件路径的问题,因为在我的电脑上,您通过链接提供的数据都像魅力一样工作。尝试添加setwd("path/to/directory/with/hdf/file") 我用这个额外的行编辑我的答案。该代码正是您将代码包装到以文件path 作为参数的函数中,因此e 的应用方式与您应用它的方式相同(在crop_kndvi &lt;- crop(kndvi, e) 行中)
    • 代码现在可以工作,但是在处理了几个文件后,我得到了这个错误。 Error in h(simpleError(msg, call)) : error in evaluating the argument 'x' in selecting a method for function 'is.factor': Failure during raster IO In addition: There were 50 or more warnings (use warnings() to see the first 50)。是的,我后来注意到你包括了范围。
    • 我也尝试使用snowfall 库,但是在sfInit(parallel=TRUE, cpus=length(hdf)) 这一行之后,我收到了以下错误消息Error in file(con, "w") : all connections are in use In addition: There were 50 or more warnings (use warnings() to see the first 50) Error in sfInit(parallel = TRUE, cpus = length(hdf)) : Starting of snow cluster failed! Error in file(con, "w") : all connections are in use Error in file(con, "w") : all connections are in use
    • 这个错误从来没有发生在我身上,所以我想我不能帮助你。看来您的 CPU 已经很忙了,也许您正在运行其他操作。例如,像 ArcGis 这样的软件会以静默方式并行执行多项操作,并且可以使用您 PC 上的所有工作人员
    【解决方案3】:
    hdf_files <- list.files("foldername", pattern = ".hdf")
    
    for(f in files) { ... }
    

    对于保存代码,您可以使用字符串“f”为文件创建一个名称,这样它们就不会相互重叠。

    【讨论】:

    • 添加full.name=T作为list.files的参数总是一个好习惯
    • ... 中包含特定代码有助于回答问题。 full.names = TRUE 的评论也将真正取决于 for 循环中的代码
    • 糟糕,是的,full.names = TRUE 始终是我在代码出错后添加的位。道歉!也为我放置...的不完整位道歉
    猜你喜欢
    • 2020-12-14
    • 1970-01-01
    • 1970-01-01
    • 2021-06-01
    • 1970-01-01
    • 2012-03-12
    • 1970-01-01
    • 1970-01-01
    • 2016-07-22
    相关资源
    最近更新 更多