R：不同日期栅格层之间的线性外推

Question

已经有一个thread 处理不同年份（2006、2008、2010、2012）栅格层之间的插值。现在，我尝试使用 @Ram Narasimhan 和 approxExtrap 从 Hmisc 包中建议的方法线性推断到 2020 年：

library(raster)
library(Hmisc)

df <- data.frame("2006" = 1:9, "2008" = 3:11, "2010" = 5:13, "2012"=7:15)

#transpose since we want time to be the first col, and the values to be columns
new <- data.frame(t(df))
times <- seq(2006, 2012, by=2)
new <- cbind(times, new)

# Now, apply Linear Extrapolate for each layer of the raster
approxExtrap(new, xout=c(2006:2012), rule = 2)

但不是得到这样的东西：

#  times X1 X2 X3 X4 X5 X6 X7 X8 X9
#1  2006  1  2  3  4  5  6  7  8  9
#2  2007  2  3  4  5  6  7  8  9 10
#3  2008  3  4  5  6  7  8  9 10 11
#4  2009  4  5  6  7  8  9 10 11 12
#5  2010  5  6  7  8  9 10 11 12 13
#6  2011  6  7  8  9 10 11 12 13 14
#7  2012  7  8  9 10 11 12 13 14 15
#8  2013  8  9 10 11 12 13 14 15 16
#9  2014  9 10 11 12 13 14 15 16 17
#10 2015 10 11 12 13 14 15 16 17 18
#11 2016 11 12 13 14 15 16 17 18 19
#12 2017 12 13 14 15 16 17 18 19 20
#13 2018 13 14 15 16 17 18 19 20 21
#14 2019 14 15 16 17 18 19 20 21 22
#15 2020 15 16 17 18 19 20 21 22 23

我明白了：

$x
 [1] 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020

$y
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15

这很令人困惑，因为approxTime 和approxExtrap 都是基于approxfun。

Answer 1

我找到了一种方法来完成这项工作，尽管它似乎不是最优雅的方法。基本思想是首先使用approxTime 执行线性插值，然后使用lm 将线性模型拟合到时间序列，并使用predict 和外推的最后一年进行外推。第一次插值的最后一年和年末之间的数据差距由再次使用approxTime 的第二次线性插值填充。

注意：第一个线性插值并不是真正需要的，尽管我不知道当您使用更复杂的数据时它是否有任何区别。

library(raster)
library(Hmisc)
library(simecol)


df <- data.frame("2006" = 1:9, "2008" = 3:11, "2010" = 5:13, "2012"=7:15)

#transpose since we want time to be the first col, and the values to be columns
new <- data.frame(t(df))
times <- seq(2006, 2012, by=2)
new <- cbind(times, new)



# Now, apply Linear Interpolate for each layer of the raster
intp<-approxTime(new, 2006:2012, rule = 2)

#Extract the years from the data.frame
tm<-intp[,1]

#Define a function for a linear model using lm
lm.func<-function(i) {lm(i ~ tm)}

#Define a new data.frame without the years from intp
intp.new<-intp[,-1]

#Creates a list of the lm coefficients for each column of intp.new
lm.list<-apply(intp.new, MARGIN=2, FUN=lm.func)

#Create a data.frame of the final year of your extrapolation; keep the name of tm data.frame
new.pred<-data.frame(tm = 2020)

#Make predictions for the final year for each element of lm.list
pred.points<-lapply(lm.frame, predict, new.pred)

#unlist the predicted points
fintime<-matrix(unlist(pred.points))

#Add the final year to the fintime matrix and transpond it
fintime.new<-t(rbind(2020,fintime))

#Convert the intp data.frame into a matrix
intp.ma<-as.matrix(intp)

#Append fintime.new to intp.ma
intp.wt<-as.data.frame(rbind(intp.ma,fintime.new))

#Perform an linear interpolation with approxTime again
approxTime(intp.wt, 2006:2020, rule = 2)


times X1 X2 X3 X4 X5 X6 X7 X8 X9
1   2006  1  2  3  4  5  6  7  8  9
2   2007  2  3  4  5  6  7  8  9 10
3   2008  3  4  5  6  7  8  9 10 11
4   2009  4  5  6  7  8  9 10 11 12
5   2010  5  6  7  8  9 10 11 12 13
6   2011  6  7  8  9 10 11 12 13 14
7   2012  7  8  9 10 11 12 13 14 15
8   2013  8  9 10 11 12 13 14 15 16
9   2014  9 10 11 12 13 14 15 16 17
10  2015 10 11 12 13 14 15 16 17 18
11  2016 11 12 13 14 15 16 17 18 19
12  2017 12 13 14 15 16 17 18 19 20
13  2018 13 14 15 16 17 18 19 20 21
14  2019 14 15 16 17 18 19 20 21 22
15  2020 15 16 17 18 19 20 21 22 23