如何将 R 代码从旧包的函数转换为当前版本 R 中的工作函数

How can I turn R code from an old package's function into a working function in the current version of R

我通常使用 Matlab,在 R 方面我只是一个业余爱好者。从 2011 年开始,我一直在尝试使用别人的代码,它正在调用一个名为 'xyValues' 的函数。我发现这曾经在 Raster 包(版本 1.5.8)中起作用,但不再出现在当前版本中。 旧的光栅包与新版本的 R 不兼容。我曾尝试降级 R,但这会导致其他问题。

我已经下载了 tar.gz 文件并提取了 xyValues 函数的代码。我试图将它粘贴到我的较新版本的 Raster 包中,但不出所料,它没有用。 有没有一种简单的方法可以让我把这个函数的代码变成一个我可以保存然后使用的实际函数(就像我自己写的函数一样)?我可以在 matlab 中轻松做到这一点,但在 R 中编写函数的过程似乎有点不同,我真的不知道从哪里开始?我在这个网站上看到了这个问题的一些变体,但我想知道 R 的新用户(比如我)是否有可能按照我的建议去做。也许只有你对R有很多了解才有可能。这是我提取的代码:

# Author: Robert J. Hijmans
# contact: r.hijmans@gmail.com
# Date : November 2008
# Version 0.9
# Licence GPL v3


if (!isGeneric("xyValues")) {
  setGeneric("xyValues", function(object, xy, ...)
    standardGeneric("xyValues"))
}   


setMethod("xyValues", signature(object='Raster', xy='SpatialPoints'), 
          function(object, xy, method='simple', buffer=NULL, fun=NULL, na.rm=TRUE,...) { 
            callGeneric(object, coordinates(xy),  method, buffer, fun, na.rm, ...)
          } 
)


setMethod("xyValues", signature(object='Raster', xy='data.frame'), 
          function(object, xy, method='simple', buffer=NULL, fun=NULL, na.rm=TRUE,...) { 
            callGeneric(object, as.matrix(xy), method, buffer, fun, na.rm, ...)
          } 
)


setMethod("xyValues", signature(object='Raster', xy='vector'), 
          function(object, xy, method='simple', buffer=NULL, fun=NULL, na.rm=TRUE, ...) { 
            if (length(xy) == 2) {
              callGeneric(object, matrix(xy, ncol=2), method, buffer, fun, na.rm,  ...)
            } else {
              stop('xy coordinates should be a two-column matrix or data.frame, or a vector of two numbers.')
            }
          } )


setMethod("xyValues", signature(object='RasterLayer', xy='matrix'), 
          function(object, xy, method='simple', buffer=NULL, fun=NULL, na.rm=TRUE, ...) { 

            if (dim(xy)[2] != 2) {
              stop('xy has wrong dimensions; it should have 2 columns' )
            }

            if (! is.null(buffer)) {
              if (method != 'simple') { warning('method argument is ignored when a buffer is used') }
              return( .xyvBuf(object, xy, buffer, fun, na.rm=na.rm) )
            }

            if (method=='bilinear') {
              return(.bilinearValue(object, xy))
            } else if (method=='simple') {
              cells <- cellFromXY(object, xy)
              return(.readCells(object, cells))
            } else {
              stop('invalid method argument. Should be simple or bilinear.')
            }
          } 
)   


setMethod("xyValues", signature(object='RasterStack', xy='matrix'), 
          function(object, xy, method='simple', buffer=NULL, fun=NULL, na.rm=TRUE, ...) { 
            .xyvStackBrick(object, xy, method, buffer, fun, na.rm, ...)
          } )

setMethod("xyValues", signature(object='RasterBrick', xy='matrix'), 
          function(object, xy, method='simple', buffer=NULL, fun=NULL, na.rm=TRUE, ...) { 
            .xyvStackBrick(object, xy, method, buffer, fun, na.rm, ...)
          } )


.xyvStackBrick <- function(object, xy, method='simple', buffer=NULL, fun=NULL, na.rm=TRUE, ...) { 

  dots <- list(...)
  layer <- dots$layer
  n <- dots$nl
  nls <- nlayers(object)

  if (is.null(layer)) { layer <- 1 } 
  if (is.null(n)) { n <- nls } 
  layer <- min(max(1, round(layer)), nls)
  n <- min(max(1, round(n)), nls-layer+1)

  if (dim(xy)[2] != 2) {
    stop('xy has wrong dimensions; there should be 2 columns only' )
  }

  if (! is.null(buffer)) {
    if (method != 'simple') { warning('method argument is ignored when a buffer is used') }
    return( .xyvBuf(object, xy, buffer, fun, na.rm, layer=layer, n=n) )
  }

  if (method == 'bilinear') {
    result <- .bilinearValue(object, xy, layer=layer, n=n)
    return(result)      

  } else if (method=='simple') {

    cells <- cellFromXY(object, xy)
    return( cellValues(object, cells, layer=layer, n=n) )

  } else {
    stop('invalid method argument. Should be simple or bilinear.')
  }
}

作为这个问题的后续,最初,当我想看看这个函数是否在我的光栅包中时,我尝试输入 help(xyValues) 但没有任何结果(因为它不存在)。但是,当我针对包中确实存在的功能尝试此操作时,它们也没有出现。这是否意味着我的光栅包未正确加载?

我使用的代码片段是:

elevgrid <- xyValues(elev,cbind(xygrid[,2],xygrid[,1]))

其中 elev 是大小为 920x1000 的正式 class 栅格图层,xygrid 是 2 个变量的 4800 个观测值(x y 坐标)

我尝试使用:

> source("C:/Users/Documents/raster/R/xyValues.R")

但我得到了所有这些错误:

in method for ‘xyValues’ with signature ‘object="Raster",xy="data.frame"’: no definition for class “Raster”
in method for ‘xyValues’ with signature ‘object="Raster",xy="vector"’: no definition for class “Raster”
in method for ‘xyValues’ with signature ‘object="RasterLayer",xy="matrix"’: no definition for class “RasterLayer”
in method for ‘xyValues’ with signature ‘object="RasterStack",xy="matrix"’: no definition for class “RasterStack”
in method for ‘xyValues’ with signature ‘object="RasterBrick",xy="matrix"’: no definition for class “RasterBrick”
Warning message:
in method for ‘xyValues’ with signature ‘object="Raster",xy="SpatialPoints"’: no definition for classes “Raster”, “SpatialPoints” 

我尝试了 getvaluesapproxNA 函数并得到了这个:

> elevgrid <- getValues(elev,cbind(xygrid[,2],xygrid[,1]))
Error in (function (classes, fdef, mtable)  : 
  unable to find an inherited method for function ‘getValues’ for signature ‘"RasterLayer", "matrix", "missing"’
> elevgrid <- approxNA(elev)
Error in (function (classes, fdef, mtable)  : 
  unable to find an inherited method for function ‘approxNA’ for signature ‘"RasterLayer"’

您可以通过多种方式解决此问题。

首先也是最重要的:

你真的需要旧函数来完成这项工作,还是可以用新一代函数来完成?我不太清楚你想做什么,所以我不能建议更好的功能。

根据我对您正在做的事情的假设以及 xyValues() 的帮助文档,这是我的猜测。 首先,您需要使用 approxNA()(requires stack) 这会执行插值,就像在 xyValues() 中一样,以在栅格中填充 NAs。然后你需要把它变成一个 data.frame 或者 vector 的值。这可以通过 as.data.frame()getValues() 来完成。 如果您没有需要填写的 NA,您可以使用 getValues()as.data.frame()

提取值
dat.r <- raster(matrix(nrow = 100,ncol = 100,sample(x = 1:1000,size = 10000,replace = T)))
dat.vector <- getValues(dat.r)
dat.dataframe <- as.data.frame(dat.r)

如果你有 NA - 我在这里找到了一个建议:

## Add in some NAs
dat.r[sample(1:10000,1000)] <- NA
fill.na <- function(x) {
  center = 0.5 + (width*width/2) 
  if( is.na(x)[center] ) {
    return( round(mean(x, na.rm=TRUE),0) )
  } else {
    return( round(x[center],0) )
  }
}  
  
width = 9
r2 <- focal(dat.r, w = matrix(1,width,width), fun = fill.na, 
            pad = TRUE, na.rm = FALSE)
dat.vector <- getValues(r2)
dat.dataframe<- as.data.frame(r2)

第二个:

您可以从解压缩的 tar.

中获取您需要的一切
source("~/raster_1.5-8/raster/R/xyValues.R")
source("~/raster_1.5-8/raster/R/xyValuesBuffer.R")
source("~/raster_1.5-8/raster/R/bilinearValue.R")
source("~/raster_1.5-8/raster/R/readCells.R")

~ 是你解压到的目录 raster_1.5-8 快速说明为什么有 4 个脚本,而不仅仅是您想要的 1 个。任何以 .是一个隐藏函数,它随包一起加载但不能显式执行。由于您没有实例化包,因此您需要这些辅助函数。

第三个不推荐:

您可以按照此处的说明尝试安装旧版本的软件包。 https://support.rstudio.com/hc/en-us/articles/219949047-Installing-older-versions-of-packages 您需要的代码是:

require(devtools)
install_version("raster", version = "1.5-8", repos = "http://cran.us.r-project.org/")

如果您尝试使用当前的生成函数,这可能会导致后续问题,因此我不推荐这种方法

xyValyes 方法使用点(xy 坐标)从栅格中提取值。此函数已替换为 extract。所以而不是

library(raster)
xyValues(x, xy, ...)

你应该可以做到

extract(x, xy, ...)