R : 서로 다른 날짜의 래스터 레이어 간의 선형 외삽

Question

이미 다른 연도 (2006200820102012)의 래스터 레이어 간 보간법을 다루는 thread이 있습니다. 지금은 선형 Hmisc 패키지에서 @Ram Narasimhan과 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 

이것은 approxfun을 기반으로 approxTime 및 approxExtrap 모두로 매우 혼란 스럽다.

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