└── modis_interpolate.R /modis_interpolate.R: -------------------------------------------------------------------------------- 1 | library(raster) 2 | library(gstat) 3 | library(spacetime) 4 | library(reshape) 5 | library(plot3D) 6 | library(zoo) 7 | library(rasterVis) 8 | workDir <- "/Users/liziqi/Desktop/Nor_100X100" 9 | setwd(workDir) 10 | filenames <- list.files(pattern="*.tif", full.names=TRUE) 11 | 12 | #create raster brick 13 | r<-brick() 14 | for(i in 1:120){ 15 | r<-addLayer(r,raster(filenames[i])) 16 | } 17 | 18 | #get best summer and winter 19 | summer = r$LST_2003_06 20 | winter = r$LST_2008_01 21 | worst = r$LST_2011_08 22 | #interpolation 23 | stfdf.winter = as.data.frame(winter,row.names=NULL) 24 | stfdf.winter = melt(stfdf.winter) 25 | stfdf.winter = stfdf.winter[,2] 26 | stfdf.winter = data.frame(values = signif(stfdf.winter,6)) 27 | stfdf.winter = stfdf.winter-273.16 28 | sp = SpatialPoints(coordinates(winter)) 29 | 30 | winter.df = SpatialPointsDataFrame(sp, stfdf.winter,proj4string=CRS(winter)) 31 | www = variogram(values~1, winter.df,width=1000) 32 | www.fit = fit.variogram(www, vgm(40, "Exp", 50000, 1)) 33 | krig <- krige.cv(values~1, winter.df, vgm(18, "Exp", 50000, 1), nmax = 100, nfold=5) 34 | idw <- krige.cv(values~1, winter.df, nmax = 100, nfold=5)#idw 35 | fit = lm(krig$observed ~krig$var1.pred) 36 | plot(x$observed~x$var1.pred) 37 | summary(fit) 38 | 39 | #summer 40 | stfdf.summer = as.data.frame(summer,row.names=NULL) 41 | stfdf.summer = melt(stfdf.summer) 42 | stfdf.summer = stfdf.summer[,2] 43 | stfdf.summer = data.frame(values = signif(stfdf.summer,6)) 44 | stfdf.summer = stfdf.summer-273.16 45 | sp = SpatialPoints(coordinates(winter)) 46 | summer.df = SpatialPointsDataFrame(sp, stfdf.summer,proj4string=CRS(summer)) 47 | 48 | sss = variogram(values~1, summer.df,width=1000) 49 | sss.fit = fit.variogram(sss, vgm(40, "Exp", 50000, 1)) 50 | x <- krige.cv(values~1, summer.df, vgm(40, "Exp", 50000, 1), nmax = 100, nfold=5) 51 | x <- krige.cv(values~1, summer.df, nmax = 100, nfold=5)#idw 52 | fit = lm(x$observed ~x$var1.pred) 53 | summary(fit) 54 | 55 | #plot 56 | plot(idw$observed,idw$var1.pred,xlim = c(-50,-25),ylim=c(-50,-25),xlab="IDW_Predicted (°C)",ylab="Observed (°C)",main="IDW Cross Validation") 57 | abline(a=0,b=1,col="red") 58 | dev.copy(png,'myplot.png') 59 | dev.off() 60 | 61 | plot(krig$observed,krig$var1.pred,xlim = c(-50,-25),ylim=c(-50,-25),xlab="Krig_Predicted (°C)",ylab="Observed (°C)",main="Kriging Cross Validation") 62 | abline(a=0,b=1,col="red") 63 | 64 | plot(idw$observed,idw$residual,ylim = c(-5,5),xlim = c(-25,-50),xlab="IDW_Observed (°C)",ylab="Residuals (°C)",main="IDW Cross Validation") 65 | plot(krig$observed,krig$residual,ylim = c(-5,5),xlim = c(-25,-50),xlab="Krig_Observed (°C)",ylab="Residuals (°C)",main="Kriging Cross Validation") 66 | dev.copy(png,'myplot.png') 67 | dev.off() 68 | 69 | spplot(worst,at= seq(5,25,1),col.regions=colorRampPalette(c('blue', 'yellow','red')),ylab="Northing",xlab="Easting") 70 | 71 | #get monthly annual average 72 | monthly = ts(c(cellStats(r, 'mean')) ,start = c(2002,1),frequency = 12) 73 | monthly.mean = tapply(monthly, cycle(air.ts), mean,na.rm=T) 74 | 75 | #deseasonalized 76 | for(i in 1:120){ 77 | mon = i%%12 78 | if (mon==0) {mon = 12} 79 | r[[i]] = r[[i]] - monthly.mean[mon][[1]] 80 | } 81 | 82 | 83 | #variogram 84 | mydata = as.data.frame(r,row.names=NULL) 85 | mydata = melt(mydata) 86 | mydata = mydata[,2] 87 | mydata = data.frame(values = signif(mydata,6)) 88 | #mydata = mydata-273.16 89 | YM <- as.yearmon(2002 + seq(0, 119)/12) 90 | sp = SpatialPoints(coordinates(r)) 91 | stfdf = STFDF(sp, YM, mydata) 92 | stplot(stfdf,col.regions=rev(heat.colors(60))) 93 | ddd = variogramST(values~1,stfdf,width = 5000,cutoff=50000,tlags=0:5) 94 | 95 | #get Map of NAs 96 | na.count = is.na(subset(r,1)) 97 | for(i in 2:120){ 98 | nalayer = is.na(subset(r,i)) 99 | na.count = na.count + nalayer 100 | } 101 | 102 | na.count = as.data.frame(na.count,row.names=NULL) 103 | na.count = melt(na.count) 104 | na.count = na.count[,2] 105 | na.count = data.frame(values = signif(na.count,6)) 106 | sp = SpatialPoints(coordinates(winter)) 107 | 108 | na.df = SpatialPointsDataFrame(sp, na.count,proj4string=CRS(winter)) 109 | na.df =as.data.frame(na.df) 110 | scatterplot3d(na.df$x,na.df$y,na.df$values,type="h",pch="",zlab="Missing Value Counts",xlab="Easting",ylab="Northing",zlim=c(1,60),lwd = 2) 111 | 112 | plot3D(na.count) 113 | 114 | # 115 | r1 = subset(r,1) 116 | r1.df = as.data.frame(r1,row.names=NULL) 117 | r1.df = melt(mydata) 118 | r1.df = mydata[,2] 119 | r1.df = data.frame(values = signif(r1.df,6)) 120 | r1.df = r1.df-273.16 121 | YM <- as.yearmon("2002-01") 122 | stfdf = STFDF(sp, YM, r1.df) 123 | 124 | 125 | 126 | #2002 only 127 | workDir <- "/Users/liziqi/Desktop/Nor_2002" 128 | setwd(workDir) 129 | filenames <- list.files(pattern="*.tif", full.names=TRUE) 130 | r.2002<-brick() 131 | for(i in 1:12){ 132 | r.2002<-addLayer(r.2002,raster(filenames[i])) 133 | } 134 | for(i in 1:12){ 135 | mon = i%%12 136 | if (mon==0) {mon = 12} 137 | r.2002[[i]] = r.2002[[i]] - monthly.mean[mon][[1]] 138 | } 139 | 140 | mydata = as.data.frame(r.2002,row.names=NULL) 141 | mydata = melt(mydata) 142 | mydata = mydata[,2] 143 | mydata = data.frame(values = signif(mydata,6)) 144 | 145 | YM <- as.yearmon(2002 + seq(0, 11)/12) 146 | sp = SpatialPoints(coordinates(r.2002)) 147 | stfdf = STFDF(sp, YM, mydata) 148 | ddd = variogramST(values~1,stfdf,width = 5000,cutoff=50000,tlags=0:12) 149 | 150 | plot(ddd,wireframe=T,col.regions=bpy.colors(1000),convertMonths=T,xlab=list("distance (km)", rot=30),plot.numbers=T,auto.key=T,all=T,scales=list(arrows=F, z = list(distance = 5)),zlim=c(0,1000),zlab="semivariance") 151 | 152 | 153 | 154 | prodSumModel <- vgmST("productSum", space=vgm(16, "Exp", 40000), time= vgm(1000, "Per", 1),sill = 50,stAni=200000,nugget=0) 155 | 156 | 157 | 158 | x=sample(1:100, 30, replace=F) 159 | y=sample(1:100, 30, replace=F) 160 | for (i in 1:30){ 161 | cell<-c(r[x[i],y[i]]) 162 | cell.up<-c(r[x[i],y[i]-1]) 163 | cell.down<-c(r[x[i],y[i]+1]) 164 | cell.left<-c(r[x[i]-1,y[i]]) 165 | cell.right<-c(r[x[i]+1,y[i]]) 166 | fit.up<-lm(formula = cell ~ cell.up, na.rm = TRUE) 167 | fit.down<-lm(formula = cell ~ cell.down, na.rm = TRUE) 168 | fit.left<-lm(formula = cell ~ cell.left, na.rm = TRUE) 169 | fit.right<-lm(formula = cell ~ cell.right, na.rm = TRUE) 170 | udlr<-c(summary(fit.up)$r.squared, summary(fit.down)$r.squared, summary(fit.left)$r.squared, summary(fit.right)$r.squared) 171 | print(udlr) 172 | } 173 | 174 | #Get station data 175 | a = cbind(88.30,69.33) 176 | xy = SpatialPoints(a,CRS("+init=epsg:4326")) 177 | xy = spTransform(xy,crs("+init=epsg:3408")) 178 | air = extract(r,xy) 179 | m = colMeans(matrix(air, nrow=12)) 180 | m = m-273.16 181 | acf(na.omit(air),120,xlab="time lag (month)",ylab="correlation",main="Temporal Autocorrelation",type= "correlation",ylim=c(-1,1)) 182 | 183 | 184 | --------------------------------------------------------------------------------