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

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

1 个答案: