R：不同日期的柵格圖層之間的線性外推

Question

已經有一個線程處理不同年份（2006、2008、2010、2012）的柵格圖層之間的插值。 現在，我嘗試使用@Ram Narasimhan和Hmisc軟件包中的approxExtrap建議的方法線性推算到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