1
|
##################################### METHODS COMPARISON part 5 ##########################################
|
2
|
#################################### Spatial Analysis ############################################
|
3
|
#This script utilizes the R ojbects created during the interpolation phase. #
|
4
|
#This scripts focuses on a detailed study of differences in the predictions of CAI_kr and FUsion_Kr
|
5
|
#Differences are examined through:
|
6
|
#1) per land cover classes
|
7
|
#2) per elevation classes
|
8
|
#3) through spiatial transects
|
9
|
#
|
10
|
#Note this code is for exploratory analyses so some sections are not succinct and
|
11
|
#can be improve for repeatability and clarity.
|
12
|
#AUTHOR: Benoit Parmentier #
|
13
|
#DATE: 12/04/2012 #
|
14
|
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#491 -- #
|
15
|
###################################################################################################
|
16
|
|
17
|
###Loading R library and packages
|
18
|
library(gtools) # loading some useful tools such as mixedsort
|
19
|
library(mgcv) # GAM package by Wood 2006 (version 2012)
|
20
|
library(sp) # Spatial pacakge with class definition by Bivand et al. 2008
|
21
|
library(spdep) # Spatial package with methods and spatial stat. by Bivand et al. 2012
|
22
|
library(rgdal) # GDAL wrapper for R, spatial utilities (Keitt et al. 2012)
|
23
|
library(gstat) # Kriging and co-kriging by Pebesma et al. 2004
|
24
|
library(automap) # Automated Kriging based on gstat module by Hiemstra et al. 2008
|
25
|
library(spgwr)
|
26
|
library(gpclib)
|
27
|
library(maptools)
|
28
|
library(graphics)
|
29
|
library(parallel) # Urbanek S. and Ripley B., package for multi cores & parralel processing
|
30
|
library(raster)
|
31
|
library(rasterVis)
|
32
|
library(plotrix) #Draw circle on graph
|
33
|
library(reshape)
|
34
|
######### Functions used in the script
|
35
|
#loading R objects that might have similar names
|
36
|
load_obj <- function(f)
|
37
|
{
|
38
|
env <- new.env()
|
39
|
nm <- load(f, env)[1]
|
40
|
env[[nm]]
|
41
|
}
|
42
|
|
43
|
plot_transect<-function(list_trans,r_stack,title_plot,disp=TRUE){
|
44
|
#This function creates plot of transects for stack of raster images.
|
45
|
#The parameters are:
|
46
|
#list_trans: list of files containing the transects lines in shapefile format
|
47
|
#r_stack: raster stack of files
|
48
|
#title_plot: plot title
|
49
|
#disp: dispaly and save from X11 if TRUE
|
50
|
nb<-length(list_trans)
|
51
|
t_col<-rainbow(nb)
|
52
|
list_trans_data<-vector("list",nb)
|
53
|
for (i in 1:nb){
|
54
|
trans_file<-list_trans[[i]][1]
|
55
|
filename<-sub(".shp","",trans_file) #Removing the extension from file.
|
56
|
transect<-readOGR(".", filename) #reading shapefile
|
57
|
trans_data<-extract(r_stack, transect)
|
58
|
if (disp==FALSE){
|
59
|
png(file=paste(list_trans[[i]]),".png",sep="")
|
60
|
}
|
61
|
for (k in 1:ncol(trans_data[[1]])){
|
62
|
y<-trans_data[[1]][,k]
|
63
|
x<-1:length(y)
|
64
|
if (k!=1){
|
65
|
lines(x,y,col=t_col[k])
|
66
|
}
|
67
|
if (k==1){
|
68
|
plot(x,y,type="l",xlab="Position index", ylab="temperature",col=rainbow(k))
|
69
|
}
|
70
|
}
|
71
|
title(title_plot[i])
|
72
|
legend("topright",legend=layerNames(r_stack),
|
73
|
cex=1.2, col=t_col,
|
74
|
lty=1)
|
75
|
|
76
|
if (disp==TRUE){
|
77
|
savePlot(file=paste(list_trans[[i]][2],".png",sep=""),type="png")
|
78
|
}
|
79
|
if (disp==FALSE){
|
80
|
dev.off()
|
81
|
}
|
82
|
list_trans_data[[i]]<-trans_data
|
83
|
}
|
84
|
names(list_trans_data)<-names(list_trans)
|
85
|
return(list_trans_data)
|
86
|
}
|
87
|
|
88
|
plot_transect_m<-function(list_trans,r_stack,title_plot,disp=TRUE,m_layers){
|
89
|
#This function creates plot of transects for stack of raster images.
|
90
|
#Arguments:
|
91
|
#list_trans: list of files containing the transects lines in shapefile format
|
92
|
#r_stack: raster stack containing the information to extect
|
93
|
#title_plot: plot title
|
94
|
#disp: display and save from X11 if TRUE or plot to png file if FALSE
|
95
|
#m_layers: index for layerers containing alternate units to be drawned on a differnt scale
|
96
|
#RETURN:
|
97
|
#list containing transect information
|
98
|
|
99
|
nb<-length(list_trans)
|
100
|
t_col<-rainbow(nb)
|
101
|
list_trans_data<-vector("list",nb)
|
102
|
|
103
|
#For scale 1
|
104
|
for (i in 1:nb){
|
105
|
trans_file<-list_trans[[i]][1]
|
106
|
filename<-sub(".shp","",trans_file) #Removing the extension from file.
|
107
|
transect<-readOGR(".", filename) #reading shapefile
|
108
|
trans_data<-extract(r_stack, transect)
|
109
|
if (disp==FALSE){
|
110
|
png(file=paste(list_trans[[i]]),".png",sep="")
|
111
|
}
|
112
|
#Plot layer values for specific transect
|
113
|
for (k in 1:ncol(trans_data[[1]])){
|
114
|
y<-trans_data[[1]][,k]
|
115
|
x<-1:length(y)
|
116
|
m<-match(k,m_layers)
|
117
|
|
118
|
if (k==1 & is.na(m)){
|
119
|
plot(x,y,type="l",xlab="Position index", ylab="temperature",col=t_col[k])
|
120
|
axis(2,xlab="",ylab="tmax (in degree C)")
|
121
|
}
|
122
|
if (k==1 & !is.na(m)){
|
123
|
plot(x,y,type="l",col=t_col[k],axes=F) #plotting fusion profile
|
124
|
axis(4,xlab="",ylab="tmax (in degree C)")
|
125
|
|
126
|
}
|
127
|
if (k!=1 & is.na(m)){
|
128
|
#par(new=TRUE) # new plot without erasing old
|
129
|
lines(x,y,type="l",col=t_col[k],axes=F) #plotting fusion profile
|
130
|
#axis(2,xlab="",ylab="tmax (in degree C)")
|
131
|
}
|
132
|
if (k!=1 & !is.na(m)){
|
133
|
par(new=TRUE) # key: ask for new plot without erasing old
|
134
|
plot(x,y,type="l",col=t_col[k],axes=F) #plotting fusion profile
|
135
|
#axis(4,xlab="",ylab="tmax (in degree C)")
|
136
|
}
|
137
|
|
138
|
}
|
139
|
title(title_plot[i])
|
140
|
legend("topright",legend=layerNames(r_stack),
|
141
|
cex=1.2, col=t_col,
|
142
|
lty=1)
|
143
|
|
144
|
if (disp==TRUE){
|
145
|
savePlot(file=paste(list_trans[[i]][2],".png",sep=""),type="png")
|
146
|
}
|
147
|
if (disp==FALSE){
|
148
|
dev.off()
|
149
|
}
|
150
|
list_trans_data[[i]]<-trans_data
|
151
|
}
|
152
|
names(list_trans_data)<-names(list_trans)
|
153
|
return(list_trans_data)
|
154
|
}
|
155
|
|
156
|
transect_from_spdf<-function (spdf,selected_features){
|
157
|
#This function produces a transect from a set of selected points in a point layer
|
158
|
# Arguments:
|
159
|
# spdf: SpatialPointDataFrame
|
160
|
# selected_features: index of ssubset points used in the transect line
|
161
|
# Return: SpatialLinesDataframe object corresponding to the transect
|
162
|
# Author: Benoit Parmentier
|
163
|
# Date: 11-29-2012
|
164
|
|
165
|
dat_id<-spdf[selected_features,] #creating new subset from spdf
|
166
|
spdf_proj<-proj4string(dat_id)
|
167
|
matrix_point_coords<-coordinates(dat_id)
|
168
|
#Add possibility of keeping attributes?
|
169
|
#Transform a sequence of points with coords into Spatial Lines
|
170
|
#Note that X is the ID, modify for dataframe?
|
171
|
trans4<-SpatialLines(list(Lines(list(Line(coordinates(matrix_point_coords))),"X")))
|
172
|
tmp<-as.data.frame(dat_id[1,])
|
173
|
row.names(tmp)<-rep("X",1)
|
174
|
trans4<-SpatialLinesDataFrame(trans4,data=tmp)
|
175
|
proj4string(trans4)<-spdf_proj
|
176
|
return(trans4)
|
177
|
}
|
178
|
|
179
|
###Parameters and arguments
|
180
|
|
181
|
infile1<- "ghcn_or_tmax_covariates_06262012_OR83M.shp" #GHCN shapefile containing variables for modeling 2010
|
182
|
#infile2<-"list_10_dates_04212012.txt" #List of 10 dates for the regression
|
183
|
infile2<-"list_365_dates_04212012.txt" #list of dates
|
184
|
infile3<-"LST_dates_var_names.txt" #LST dates name
|
185
|
infile4<-"models_interpolation_05142012.txt" #Interpolation model names
|
186
|
infile5<-"mean_day244_rescaled.rst" #mean LST for day 244
|
187
|
inlistf<-"list_files_05032012.txt" #list of raster images containing the Covariates
|
188
|
infile6<-"OR83M_state_outline.shp"
|
189
|
#stat_loc<-read.table(paste(path,"/","location_study_area_OR_0602012.txt",sep=""),sep=",", header=TRUE)
|
190
|
|
191
|
out_prefix<-"methods_comp5_12042012_"
|
192
|
nb_transect<-4
|
193
|
##### LOAD USEFUL DATA
|
194
|
|
195
|
#obj_list<-"list_obj_08262012.txt" #Results of fusion from the run on ATLAS
|
196
|
path_wd<-"/home/parmentier/Data/IPLANT_project/methods_interpolation_comparison_10242012" #Jupiter LOCATION on Atlas for kriging #Jupiter Location on XANDERS
|
197
|
#path<-"/Users/benoitparmentier/Dropbox/Data/NCEAS/Oregon_covariates/" #Local dropbox folder on Benoit's laptop
|
198
|
setwd(path_wd)
|
199
|
path_data_cai<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations_10242012_CAI" #Change to constant
|
200
|
path_data_fus<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations_10242012_GAM"
|
201
|
#list files that contain model objects and ratingin-testing information for CAI and Fusion
|
202
|
obj_mod_fus_name<-"results_mod_obj__365d_GAM_fusion_const_all_lstd_11022012.RData"
|
203
|
obj_mod_cai_name<-"results_mod_obj__365d_GAM_CAI2_const_all_10312012.RData"
|
204
|
|
205
|
gam_fus<-load_obj(file.path(path_data_fus,obj_mod_fus_name))
|
206
|
gam_cai<-load_obj(file.path(path_data_cai,obj_mod_cai_name)) #This contains all the info
|
207
|
sampling_date_list<-gam_fus$sampling_obj$sampling_dat$date
|
208
|
|
209
|
### Projection for the current region
|
210
|
proj_str="+proj=lcc +lat_1=43 +lat_2=45.5 +lat_0=41.75 +lon_0=-120.5 +x_0=400000 +y_0=0 +ellps=GRS80 +units=m +no_defs";
|
211
|
#User defined output prefix
|
212
|
|
213
|
### MAKE THIS A FUNCTION TO LOAD STACK AND DEFINE VALID RANGE...
|
214
|
#CRS<-proj4string(ghcn) #Storing projection information (ellipsoid, datum,etc.)
|
215
|
lines<-read.table(paste(path,"/",inlistf,sep=""), sep="") #Column 1 contains the names of raster files
|
216
|
inlistvar<-lines[,1]
|
217
|
inlistvar<-paste(path,"/",as.character(inlistvar),sep="")
|
218
|
covar_names<-as.character(lines[,2]) #Column two contains short names for covaraites
|
219
|
|
220
|
s_raster<- stack(inlistvar) #Creating a stack of raster images from the list of variables.
|
221
|
layerNames(s_raster)<-covar_names #Assigning names to the raster layers
|
222
|
projection(s_raster)<-proj_str
|
223
|
|
224
|
#Create mask using land cover data
|
225
|
pos<-match("LC10",layerNames(s_raster)) #Find the layer which contains water bodies
|
226
|
LC10<-subset(s_raster,pos)
|
227
|
LC10[is.na(LC10)]<-0 #Since NA values are 0, we assign all zero to NA
|
228
|
mask_land<-LC10<100 #All values below 100% water are assigned the value 1, value 0 is "water"
|
229
|
mask_land_NA<-mask_land
|
230
|
mask_land_NA[mask_land_NA==0]<-NA #Water bodies are assigned value 1
|
231
|
|
232
|
data_name<-"mask_land_OR"
|
233
|
raster_name<-paste(data_name,".rst", sep="")
|
234
|
writeRaster(mask_land, filename=raster_name,overwrite=TRUE) #Writing the data in a raster file format...(IDRISI)
|
235
|
#writeRaster(r2, filename=raster_name,overwrite=TRUE) #Writing the data in a raster file format...(IDRISI)
|
236
|
|
237
|
pos<-match("ELEV_SRTM",layerNames(s_raster)) #Find column with name "ELEV_SRTM"
|
238
|
ELEV_SRTM<-raster(s_raster,layer=pos) #Select layer from stack on 10/30
|
239
|
s_raster<-dropLayer(s_raster,pos)
|
240
|
ELEV_SRTM[ELEV_SRTM <0]<-NA
|
241
|
mask_ELEV_SRTM<-ELEV_SRTM>0
|
242
|
|
243
|
#Change this a in loop...
|
244
|
pos<-match("LC1",layerNames(s_raster)) #Find column with name "value"
|
245
|
LC1<-raster(s_raster,layer=pos) #Select layer from stack
|
246
|
s_raster<-dropLayer(s_raster,pos)
|
247
|
LC1[is.na(LC1)]<-0
|
248
|
pos<-match("LC2",layerNames(s_raster)) #Find column with name "value"
|
249
|
LC2<-raster(s_raster,layer=pos) #Select layer from stack
|
250
|
s_raster<-dropLayer(s_raster,pos)
|
251
|
LC2[is.na(LC2)]<-0
|
252
|
pos<-match("LC3",layerNames(s_raster)) #Find column with name "value"
|
253
|
LC3<-raster(s_raster,layer=pos) #Select layer from stack
|
254
|
s_raster<-dropLayer(s_raster,pos)
|
255
|
LC3[is.na(LC3)]<-0
|
256
|
pos<-match("LC4",layerNames(s_raster)) #Find column with name "value"
|
257
|
LC4<-raster(s_raster,layer=pos) #Select layer from stack
|
258
|
s_raster<-dropLayer(s_raster,pos)
|
259
|
LC4[is.na(LC4)]<-0
|
260
|
pos<-match("LC6",layerNames(s_raster)) #Find column with name "value"
|
261
|
LC6<-raster(s_raster,layer=pos) #Select layer from stack
|
262
|
s_raster<-dropLayer(s_raster,pos)
|
263
|
LC6[is.na(LC6)]<-0
|
264
|
pos<-match("LC7",layerNames(s_raster)) #Find column with name "value"
|
265
|
LC7<-raster(s_raster,layer=pos) #Select layer from stack
|
266
|
s_raster<-dropLayer(s_raster,pos)
|
267
|
LC7[is.na(LC7)]<-0
|
268
|
pos<-match("LC9",layerNames(s_raster)) #Find column with name "LC9", this is wetland...
|
269
|
LC9<-raster(s_raster,layer=pos) #Select layer from stack
|
270
|
s_raster<-dropLayer(s_raster,pos)
|
271
|
LC9[is.na(LC9)]<-0
|
272
|
|
273
|
LC_s<-stack(LC1,LC2,LC3,LC4,LC6,LC7)
|
274
|
layerNames(LC_s)<-c("LC1_forest","LC2_shrub","LC3_grass","LC4_crop","LC6_urban","LC7_barren")
|
275
|
LC_s <-mask(LC_s,mask_ELEV_SRTM)
|
276
|
plot(LC_s)
|
277
|
|
278
|
s_raster<-addLayer(s_raster, LC_s)
|
279
|
|
280
|
#mention this is the last... files
|
281
|
|
282
|
#Read region outline...
|
283
|
filename<-sub(".shp","",infile6) #Removing the extension from file.
|
284
|
reg_outline<-readOGR(".", filename) #reading shapefile
|
285
|
|
286
|
############ PART 4: RESIDUALS ANALYSIS: ranking, plots, focus regions ##################
|
287
|
############## EXAMINING STATION RESIDUALS ###########
|
288
|
########### CONSTANT OVER 365 AND SAMPLING OVER 365
|
289
|
#Plot daily_deltaclim_rast, bias_rast,add data_s and data_v
|
290
|
|
291
|
# RANK STATION by average or median RMSE
|
292
|
# Count the number of times a station is in the extremum group of outliers...
|
293
|
# LOOK at specific date...
|
294
|
|
295
|
#Examine residuals for a spciefic date...Jan, 1 using run of const_all i.e. same training over 365 dates
|
296
|
path_data_cai<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations_10242012_CAI" #Change to constant
|
297
|
path_data_fus<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations_10242012_GAM"
|
298
|
|
299
|
date_selected<-"20100103"
|
300
|
|
301
|
oldpath<-getwd()
|
302
|
setwd(path_data_cai)
|
303
|
|
304
|
################ VISUALIZATION !!!!!!!! ############
|
305
|
#updated the analysis
|
306
|
|
307
|
dates<-c("20100103","20100901")
|
308
|
i=2
|
309
|
|
310
|
for(i in 1:length(dates)){
|
311
|
|
312
|
date_selected<-dates[i]
|
313
|
oldpath<-getwd()
|
314
|
setwd(path_data_cai)
|
315
|
file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_CAI2_const_all_10312012.rst",sep="")) #Search for files in relation to fusion
|
316
|
lf_cai2c<-list.files(pattern=file_pat) #Search for files in relation to fusion
|
317
|
rast_cai2c<-stack(lf_cai2c) #lf_cai2c CAI results with constant sampling over 365 dates
|
318
|
rast_cai2c<-mask(rast_cai2c,mask_ELEV_SRTM)
|
319
|
|
320
|
oldpath<-getwd()
|
321
|
setwd(path_data_fus)
|
322
|
file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_fusion_const_all_lstd_11022012.rst",sep="")) #Search for files in relation to fusion
|
323
|
lf_fus1c<-list.files(pattern=file_pat) #Search for files in relation to fusion
|
324
|
rast_fus1c<-stack(lf_fus1c)
|
325
|
rast_fus1c<-mask(rast_fus1c,mask_ELEV_SRTM)
|
326
|
|
327
|
#PLOT ALL MODELS
|
328
|
#Prepare for plotting
|
329
|
|
330
|
setwd(path) #set path to the output path
|
331
|
|
332
|
s_range<-c(minValue(rast_fus1c),maxValue(rast_fus1c)) #stack min and max
|
333
|
s_range<-c(min(s_range),max(s_range))
|
334
|
col_breaks <- pretty(s_range, n=50)
|
335
|
lab_breaks <- pretty(s_range, n=5)
|
336
|
temp_colors <- colorRampPalette(c('blue', 'white', 'red'))
|
337
|
X11(width=18,height=12)
|
338
|
par(mfrow=c(3,3))
|
339
|
for (k in 1:length(lf_fus1c)){
|
340
|
fus1c_r<-raster(rast_fus1c,k)
|
341
|
plot(fus1c_r, breaks=col_breaks, col=temp_colors(length(col_breaks)-1),
|
342
|
axis=list(at=lab_breaks, labels=lab_breaks))
|
343
|
}
|
344
|
plot(rast_fus1c,col=temp_colors(49))
|
345
|
savePlot(paste("fig1_diff_models_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
|
346
|
dev.off()
|
347
|
s_range<-c(minValue(rast_cai2c),maxValue(rast_cai2c)) #stack min and max
|
348
|
s_range<-c(min(s_range),max(s_range))
|
349
|
col_breaks <- pretty(s_range, n=50)
|
350
|
lab_breaks <- pretty(s_range, n=5)
|
351
|
temp_colors <- colorRampPalette(c('blue', 'white', 'red'))
|
352
|
X11(width=18,height=12)
|
353
|
par(mfrow=c(3,3))
|
354
|
for (k in 1:length(lf_fus1c)){
|
355
|
cai2c_r<-raster(rast_cai2c,k)
|
356
|
plot(cai2c_r, breaks=col_breaks, col=temp_colors(length(col_breaks)-1),
|
357
|
axis=list(at=lab_breaks, labels=lab_breaks))
|
358
|
}
|
359
|
plot(rast_cai2c,col=temp_colors(49))
|
360
|
savePlot(paste("fig2_diff_models_cai_",date_selected,out_prefix,".png", sep=""), type="png")
|
361
|
dev.off()
|
362
|
#PLOT CAI_Kr and Fusion_Kr
|
363
|
|
364
|
rast_fus_pred<-raster(rast_fus1c,1) # Select the first model from the stack i.e fusion with kriging for both steps
|
365
|
rast_cai_pred<-raster(rast_cai2c,1)
|
366
|
layerNames(rast_cai_pred)<-paste("cai",date_selected,sep="_")
|
367
|
layerNames(rast_fus_pred)<-paste("fus",date_selected,sep="_")
|
368
|
#Plot side by side
|
369
|
X11(width=16,height=9)
|
370
|
rast_pred<-stack(rast_cai_pred,rast_fus_pred)
|
371
|
layerNames(rast_pred)<-c(paste('CAI_kr',date_selected,sep=" "),paste('Fusion_kr',date_selected,sep=" "))
|
372
|
s.range <- c(min(minValue(rast_pred)), max(maxValue(rast_pred)))
|
373
|
col.breaks <- pretty(s.range, n=50)
|
374
|
lab.breaks <- pretty(s.range, n=5)
|
375
|
temp.colors <- colorRampPalette(c('blue', 'white', 'red'))
|
376
|
plot(rast_pred, breaks=col.breaks, col=temp.colors(length(col.breaks)-1),
|
377
|
axis=list(at=lab.breaks, labels=lab.breaks))
|
378
|
savePlot(paste("fig3_diff_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
|
379
|
|
380
|
#Scatter plot of fus vs cai
|
381
|
plot(values(rast_fus_pred),values(rast_cai_pred),ylab="CAI",xlab="Fusion",axis=FALSE)
|
382
|
title(paste("CAI and fusion scatterplot on ",date_selected,sep=""))
|
383
|
savePlot(paste("fig4_diff_image_scatterplot_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
|
384
|
dev.off()
|
385
|
|
386
|
## Start difference analysis
|
387
|
#Calculate difference image for the date selected
|
388
|
rast_diff<-rast_fus_pred-rast_cai_pred
|
389
|
layerNames(rast_diff)<-paste("diff",date_selected,sep="_")
|
390
|
mean_val<-cellStats(rast_diff,mean)
|
391
|
sd_val<-cellStats(rast_diff,sd)
|
392
|
|
393
|
#View classified diff and outliers...
|
394
|
diff_n_outlier<-rast_diff< (2*-sd_val) #Create negative and positive outliers...
|
395
|
diff_p_outlier<-rast_diff> (2*sd_val) #Create negative and positive outliers...
|
396
|
diff_outlier<-stack(diff_n_outlier,diff_p_outlier)
|
397
|
layerNames(diff_outlier)<-c("Negative_diff_outliers","Positive_diff_outliers")
|
398
|
bool_ramp<-colorRampPalette(c("black","red"))
|
399
|
X11()
|
400
|
plot(diff_outlier,col=bool_ramp(2))
|
401
|
savePlot(paste("fig5_diff_image_outliers_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
|
402
|
dev.off()
|
403
|
tmp<-overlay(diff_n_outlier,ELEV_SRTM,fun=function(x,y){return(x*y)})
|
404
|
#could use mask
|
405
|
tmp[tmp==0]<-NA
|
406
|
mean_Elev_n_outliers<-cellStats(tmp,mean)
|
407
|
mean_Elev<-cellStats(ELEV_SRTM,mean)
|
408
|
print(c(mean_Elev_n_outliers,mean_Elev),digits=7) #This shows that outliers are in higher areas
|
409
|
# on average: 1691m compared to 1044m
|
410
|
##postive outliers and land cover
|
411
|
#LC2 (shrub), LC1(forest),LC3(grass),LC4(crop)
|
412
|
tmp<-overlay(diff_p_outlier,LC2,fun=function(x,y){return(x*y)})
|
413
|
tmp[tmp==0]<-NA
|
414
|
mean_LC2_p_outliers<-cellStats(tmp,mean) #There is more shrub (44.84% than on average 22.32)
|
415
|
mean_LC2<-cellStats(LC2,mean)
|
416
|
print(c(mean_LC2_p_outliers,mean_LC2),digits=7) #This shows that outliers have in higher
|
417
|
#proportion of shurb (44% against 25%)
|
418
|
tmp<-overlay(diff_p_outlier,LC3,fun=function(x,y){return(x*y)})
|
419
|
tmp[tmp==0]<-NA
|
420
|
mean_LC3_p_outliers<-cellStats(tmp,mean) #There is more grass (42.73% than on average 14.47)
|
421
|
mean_LC3<-cellStats(LC3,mean)
|
422
|
print(c(mean_LC3_p_outliers,mean_LC3),digits=7) #This shows that outliers have in higher
|
423
|
#proportion of shurb (44% against 25%)
|
424
|
tmp<-overlay(diff_p_outlier,LC4,fun=function(x,y){return(x*y)})
|
425
|
tmp[tmp==0]<-NA
|
426
|
mean_LC4_p_outliers<-cellStats(tmp,mean) #There is more grass (42.73% than on average 14.47)
|
427
|
mean_LC4<-cellStats(LC4,mean)
|
428
|
print(c(mean_LC4_p_outliers,mean_LC4),digits=7) #This shows that outliers have in higher
|
429
|
|
430
|
#CREATE A TABLE
|
431
|
|
432
|
####
|
433
|
#View histogram
|
434
|
hist(rast_diff)
|
435
|
|
436
|
### More Land cover analysis related to references...
|
437
|
|
438
|
LC2<-mask(LC2,mask_ELEV_SRTM)
|
439
|
cellStats(LC2,"countNA") #Check that NA have been assigned to water and areas below 0 m
|
440
|
|
441
|
LC2_50_m<- LC2>50
|
442
|
|
443
|
LC2_50<-LC2_50_m*LC2
|
444
|
diff_LC2_50<-LC2_50_m*rast_diff
|
445
|
cellStats(diff_LC2_50,"mean")
|
446
|
plot(LC2)
|
447
|
plot(LC2_50)
|
448
|
freq(LC2_50)
|
449
|
|
450
|
#Forest NOW
|
451
|
LC1<-mask(LC1,mask_ELEV_SRTM)
|
452
|
cellStats(LC1,"countNA") #Check that NA have been assigned to water and areas below 0 m
|
453
|
|
454
|
LC1_50_m<- LC1>50
|
455
|
LC1_100_m<- LC1>=100
|
456
|
LC1_50_m[LC1_50_m==0]<-NA
|
457
|
LC1_100_m[LC1_100_m==0]<-NA
|
458
|
LC1_50<-LC1_50_m*LC1
|
459
|
LC1_100<-LC1_100_m*LC1
|
460
|
plot(LC1)
|
461
|
plot(LC1_50_m)
|
462
|
freq(LC1_50_m)
|
463
|
diff_LC1_50<-LC1_50_m*rast_diff
|
464
|
diff_LC1_100<-LC1_100_m*rast_diff
|
465
|
|
466
|
plot(diff_LC1_50)
|
467
|
cellStats(diff_LC1_50,"mean")
|
468
|
cellStats(diff_LC1_100,"mean")
|
469
|
plot(values(diff_LC1_50),values(LC1_50))
|
470
|
plot(values(diff_LC1_100),values(LC1_100))
|
471
|
x<-brick(LC1,rast_diff)
|
472
|
|
473
|
#Summarize results using plot
|
474
|
#LC1 and LC3 and LC4
|
475
|
avl<-c(0,10,1,10,20,2,20,30,3,30,40,4,40,50,5,50,60,6,60,70,7,70,80,8,80,90,9,90,100,10)#Note that category 1 does not include 0!!
|
476
|
rclmat<-matrix(avl,ncol=3,byrow=TRUE)
|
477
|
LC1_rec<-reclass(LC1,rclmat) #Loss of layer names when using reclass
|
478
|
LC2_rec<-reclass(LC2,rclmat) #Loss of layer names when using reclass
|
479
|
LC3_rec<-reclass(LC3,rclmat) #Loss of layer names when using reclass
|
480
|
LC4_rec<-reclass(LC4,rclmat) #Loss of layer names when using reclass
|
481
|
LC6_rec<-reclass(LC6,rclmat) #Loss of layer names when using reclass
|
482
|
|
483
|
#LC_s<-stack(LC1,LC3,LC4,LC6)
|
484
|
LC_s<-stack(LC1,LC2,LC3,LC4,LC6)
|
485
|
layerNames(LC_s)<-c("LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban")
|
486
|
LC_s<-mask(LC_s,mask_ELEV_SRTM)
|
487
|
LC_rec_s<-reclass(LC_s,rclmat)
|
488
|
|
489
|
#plot average difference per class of forest and LC2
|
490
|
rast_stack_zones<-LC_rec_s
|
491
|
|
492
|
avg_LC1_rec<-zonal(rast_diff,zones=LC1_rec,stat="mean",na.rm=TRUE)
|
493
|
avg_LC2_rec<-zonal(rast_diff,zones=LC2_rec,stat="mean",na.rm=TRUE)
|
494
|
avg_LC3_rec<-zonal(rast_diff,zones=LC3_rec,stat="mean",na.rm=TRUE)
|
495
|
avg_LC4_rec<-zonal(rast_diff,zones=LC4_rec,stat="mean",na.rm=TRUE)
|
496
|
avg_LC6_rec<-zonal(rast_diff,zones=LC6_rec,stat="mean",na.rm=TRUE)
|
497
|
|
498
|
std_LC1_rec<-zonal(rast_diff,zones=LC1_rec,stat="sd",na.rm=TRUE)
|
499
|
std_LC2_rec<-zonal(rast_diff,zones=LC2_rec,stat="sd",na.rm=TRUE)
|
500
|
std_LC3_rec<-zonal(rast_diff,zones=LC3_rec,stat="sd",na.rm=TRUE)
|
501
|
std_LC4_rec<-zonal(rast_diff,zones=LC4_rec,stat="sd",na.rm=TRUE)
|
502
|
std_LC6_rec<-zonal(rast_diff,zones=LC6_rec,stat="sd",na.rm=TRUE)
|
503
|
|
504
|
avg_LC_rec<-zonal(rast_diff,zones=LC_rec_s,stat="mean",na.rm=TRUE)
|
505
|
std_LC_rec<-zonal(rast_diff,zones=LC_rec_s,stat="sd",na.rm=TRUE)
|
506
|
|
507
|
zones_stat_std<-as.data.frame(cbind(std_LC1_rec,std_LC2_rec[,2],std_LC3_rec[,2],std_LC4_rec[,2],std_LC6_rec[,2]))
|
508
|
zones_stat<-as.data.frame(cbind(avg_LC1_rec,avg_LC2_rec[,2],avg_LC3_rec[,2],avg_LC4_rec[,2],avg_LC6_rec[,2]))
|
509
|
names(zones_stat)<-c("zones","LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban")
|
510
|
names(zones_stat_std)<-c("zones","LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban")
|
511
|
|
512
|
X11()
|
513
|
plot(zones_stat$zones,zones_stat$LC1_forest,type="b",ylim=c(-4.5,4.5),
|
514
|
ylab="difference between CAI and fusion",xlab="land cover percent class/10")
|
515
|
lines(zones_stat$zones,zones_stat[,3],col="red",type="b")
|
516
|
lines(zones_stat$zones,zones_stat[,4],col="blue",type="b")
|
517
|
lines(zones_stat$zones,zones_stat[,5],col="darkgreen",type="b")
|
518
|
lines(zones_stat$zones,zones_stat[,6],col="purple",type="b")
|
519
|
legend("topleft",legend=c("LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban"),
|
520
|
cex=1.2, col=c("black","red","blue","darkgreen","purple"),
|
521
|
lty=1)
|
522
|
title(paste("Prediction tmax difference and land cover ",sep=""))
|
523
|
|
524
|
savePlot(paste("fig6_diff_prediction_tmax_difference_land cover",date_selected,out_prefix,".png", sep=""), type="png")
|
525
|
dev.off()
|
526
|
|
527
|
avl<-c(0,500,1,500,1000,2,1000,1500,3,1500,2000,4,2000,2500,5,2500,4000,6)
|
528
|
rclmat<-matrix(avl,ncol=3,byrow=TRUE)
|
529
|
elev_rec<-reclass(ELEV_SRTM,rclmat) #Loss of layer names when using reclass
|
530
|
|
531
|
elev_rec_forest<-elev_rec*LC1_100_m
|
532
|
avg_elev_rec<-zonal(rast_diff,zones=elev_rec,stat="mean",na.rm=TRUE)
|
533
|
std_elev_rec<-zonal(rast_diff,zones=elev_rec,stat="sd",na.rm=TRUE)
|
534
|
avg_elev_rec_forest<-zonal(rast_diff,zones=elev_rec_forest,stat="mean",na.rm=TRUE)
|
535
|
std_elev_rec_forest<-zonal(rast_diff,zones=elev_rec_forest,stat="sd",na.rm=TRUE)
|
536
|
|
537
|
## CREATE plots
|
538
|
X11()
|
539
|
plot(avg_elev_rec[,1],avg_elev_rec[,2],type="b",ylim=c(-10,1),
|
540
|
ylab="difference between CAI and fusion",xlab="elevation classes")
|
541
|
lines(avg_elev_rec_forest[,1],avg_elev_rec_forest[,2],col="green",type="b") #Elevation and 100% forest...
|
542
|
legend("topright",legend=c("Elevation", "elev_forest"),
|
543
|
cex=1.2, col=c("black","darkgreen"),
|
544
|
lty=1)
|
545
|
title(paste("Prediction tmax difference and elevation ",sep=""))
|
546
|
savePlot(paste("fig7_diff_prediction_tmax_difference_elevation",date_selected,out_prefix,".png", sep=""), type="png")
|
547
|
dev.off()
|
548
|
#Add plots with std as CI
|
549
|
|
550
|
}
|
551
|
|
552
|
###################################################################
|
553
|
################ SPATIAL TRANSECT THROUGH THE IMAGE: ####################
|
554
|
|
555
|
#select date
|
556
|
dates<-c("20100103","20100901")
|
557
|
#j=2
|
558
|
|
559
|
for (j in 1:length(dates)){
|
560
|
|
561
|
#Read predicted tmax raster surface and modeling information
|
562
|
date_selected<-dates[j]
|
563
|
|
564
|
oldpath<-getwd()
|
565
|
setwd(path_data_cai)
|
566
|
file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_CAI2_const_all_10312012.rst",sep="")) #Search for files in relation to fusion
|
567
|
lf_cai2c<-list.files(pattern=file_pat) #Search for files in relation to fusion
|
568
|
rast_cai2c<-stack(lf_cai2c) #lf_cai2c CAI results with constant sampling over 365 dates
|
569
|
rast_cai2c<-mask(rast_cai2c,mask_ELEV_SRTM)
|
570
|
|
571
|
oldpath<-getwd()
|
572
|
setwd(path_data_fus)
|
573
|
file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_fusion_const_all_lstd_11022012.rst",sep="")) #Search for files in relation to fusion
|
574
|
lf_fus1c<-list.files(pattern=file_pat) #Search for files in relation to fusion
|
575
|
rast_fus1c<-stack(lf_fus1c)
|
576
|
rast_fus1c<-mask(rast_fus1c,mask_ELEV_SRTM)
|
577
|
|
578
|
setwd(path)
|
579
|
rast_fus_pred<-raster(rast_fus1c,1)
|
580
|
rast_cai_pred<-raster(rast_cai2c,1)
|
581
|
rast_diff_fc<-rast_fus_pred-rast_cai_pred
|
582
|
|
583
|
#Read in data_s and data_v
|
584
|
|
585
|
k<-match(date_selected,sampling_date_list)
|
586
|
names(gam_fus$gam_fus_mod[[k]]) #Show the name structure of the object/list
|
587
|
|
588
|
#Extract the training and testing information for the given date...
|
589
|
data_sf<-gam_fus$gam_fus_mod[[k]]$data_s #object for the first date...20100103 #Make this a function??
|
590
|
data_vf<-gam_fus$gam_fus_mod[[k]]$data_v #object for the first date...20100103
|
591
|
data_sc<-gam_cai$gam_CAI_mod[[k]]$data_s #object for the first date...20100103
|
592
|
data_vc<-gam_cai$gam_CAI_mod[[k]]$data_v #object for the first date...20100103
|
593
|
|
594
|
### CREATE A NEW TRANSECT BASED ON LOCATION OF SPECIFIED STATIONS
|
595
|
|
596
|
selected_stations<-c("USW00024284","USC00354126","USC00358536","USC00354835",
|
597
|
"USC00356252","USC00359316","USC00358246","USC00350694",
|
598
|
"USC00350699","USW00024230","USC00353542")
|
599
|
#add which one were training and testing
|
600
|
data_vf$training<-rep(0,nrow(data_vf))
|
601
|
data_sf$training<-rep(1,nrow(data_sf))
|
602
|
|
603
|
data_stat<-rbind(data_vf[,c("id","training")],data_sf[,c("id","training")]) #bringing together data_v and data_s
|
604
|
m<-match(selected_stations,data_stat$id)
|
605
|
m<-as.integer(na.omit(m))
|
606
|
trans4_stations<-transect_from_spdf(data_stat,m)
|
607
|
point4_stations<-data_stat[m,]
|
608
|
#tmp<-as.data.frame(data_stat[1,])
|
609
|
#row.names(tmp)<-rep("X",1)
|
610
|
#test<-SpatialLinesDataFrame(trans4_stations,data=tmp)
|
611
|
writeOGR(obj=trans4_stations,layer="t4_line",dsn="t4_line.shp",driver="ESRI Shapefile", overwrite=T)
|
612
|
## Create list of transect
|
613
|
|
614
|
list_transect<-vector("list",nb_transect)
|
615
|
list_transect[[1]]<-c("t1_line.shp",paste("figure_9_tmax_transect1_OR",date_selected,out_prefix,sep="_"))
|
616
|
list_transect[[2]]<-c("t2_line.shp",paste("figure_10_tmax_transect2_OR",date_selected,out_prefix,sep="_"))
|
617
|
list_transect[[3]]<-c("t3_line.shp",paste("figure_11_tmax_transect3_OR",date_selected,out_prefix,sep="_"))
|
618
|
list_transect[[4]]<-c("t4_line.shp",paste("figure_12_tmax_transect4_OR",date_selected,out_prefix,sep="_"))
|
619
|
|
620
|
names(list_transect)<-c("transect_OR1","transect_OR2","transect_OR3","transect_OR4")
|
621
|
|
622
|
#now add a transect for elevation
|
623
|
list_transect2<-vector("list",nb_transect)
|
624
|
list_transect2[[1]]<-c("t1_line.shp",paste("figure_13_tmax_elevation_transect1_OR",date_selected,out_prefix,sep="_"))
|
625
|
list_transect2[[2]]<-c("t2_line.shp",paste("figure_14_tmax_elevation_transect2_OR",date_selected,out_prefix,sep="_"))
|
626
|
list_transect2[[3]]<-c("t3_line.shp",paste("figure_15_tmax_elevation_transect3_OR",date_selected,out_prefix,sep="_"))
|
627
|
list_transect2[[4]]<-c("t4_line.shp",paste("figure_16_tmax_elevation_transect4_OR",date_selected,out_prefix,sep="_"))
|
628
|
|
629
|
names(list_transect2)<-c("transect_OR1","transect_OR2","transect_OR3","transect_OR4")
|
630
|
|
631
|
rast_pred<-stack(rast_fus_pred,rast_cai_pred)
|
632
|
rast_pred2<-stack(rast_fus_pred,rast_cai_pred,ELEV_SRTM)
|
633
|
layerNames(rast_pred)<-c("fus","CAI")
|
634
|
layerNames(rast_pred2)<-c("fus","CAI","elev")
|
635
|
title_plot<-paste(names(list_transect),date_selected)
|
636
|
title_plot2<-paste(names(list_transect2),date_selected)
|
637
|
#r_stack<-rast_pred
|
638
|
|
639
|
X11(width=9,height=9)
|
640
|
nb_transect<-length(list_transect)
|
641
|
s_range<-c(minValue(rast_diff_fc),maxValue(rast_diff_fc)) #stack min and max
|
642
|
col_breaks <- pretty(s_range, n=50)
|
643
|
lab_breaks <- pretty(s_range, n=7)
|
644
|
temp_colors <- colorRampPalette(c('blue', 'white', 'red'))
|
645
|
plot(rast_diff_fc, breaks=col_breaks, col=temp_colors(length(col_breaks)-1),
|
646
|
axis=list(at=lab_breaks, labels=lab_breaks))
|
647
|
for (k in 1:nb_transect){
|
648
|
trans_file<-list_transect[[k]]
|
649
|
filename<-sub(".shp","",trans_file) #Removing the extension from file.
|
650
|
transect<-readOGR(".", filename) #reading shapefile
|
651
|
plot(transect,add=TRUE)
|
652
|
}
|
653
|
|
654
|
savePlot(paste("fig8_diff_transect_path_tmax_diff_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
|
655
|
dev.off()
|
656
|
|
657
|
X11(width=18,height=9)
|
658
|
m_layers_sc<-c(3)
|
659
|
trans_data<-plot_transect(list_transect,rast_pred,title_plot,disp=TRUE)
|
660
|
|
661
|
trans_data2<-plot_transect_m(list_transect2,rast_pred2,title_plot2,disp=TRUE,m_layers_sc)
|
662
|
dev.off()
|
663
|
|
664
|
### PLOT LOCATIONS OF STATION ON FIGURES
|
665
|
|
666
|
data_stat<-rbind(data_vf[,c("id","training")],data_sf[,c("id","training")]) #bringing together data_v and data_s
|
667
|
m<-match(selected_stations,data_stat$id)
|
668
|
m<-as.integer(na.omit(m))
|
669
|
trans4_stations<-transect_from_spdf(data_stat,m)
|
670
|
point4_stations<-data_stat[m,]
|
671
|
|
672
|
pos<-match(c("x_OR83M","y_OR83M"),layerNames(s_raster)) #Find column with name "value"
|
673
|
xy_stack<-subset(s_raster,pos) #Select multiple layers from the stack
|
674
|
r_stack<-stack(xy_stack, rast_pred2)
|
675
|
trans4_data<-extract(r_stack,trans4_stations,cellnumbers=TRUE) #This extracts a list
|
676
|
trans4_data<-as.data.frame(trans4_data[[1]])
|
677
|
point4_cellID<-cellFromXY(r_stack,coordinates(point4_stations)) #This contains the cell ID the points
|
678
|
pos<-match(point4_cellID,trans4_data$cell)
|
679
|
|
680
|
#Plots lines where there are stations...
|
681
|
X11(width=18,height=9)
|
682
|
y<-trans4_data$fus
|
683
|
x <- 1:length(y)
|
684
|
plot(x,y,type="l",col="red", #plotting fusion profile
|
685
|
,xlab="",ylab="tmax (in degree C)")
|
686
|
y<-trans4_data$CAI
|
687
|
lines(x,y,col="green")
|
688
|
abline(v=pos)#addlines whtere the stations area...
|
689
|
#plot(elev)
|
690
|
#title(title_plot[i]))
|
691
|
legend("topleft",legend=c("fus","CAI"),
|
692
|
cex=1.2, col=c("red","green"),
|
693
|
lty=1)
|
694
|
savePlot(paste("fig17_transect_path_tmax_diff_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
|
695
|
|
696
|
|
697
|
y<-trans4_data$fus[1:150]
|
698
|
x <- 1:150
|
699
|
plot(x,y,type="l",col="red", #plotting fusion profile
|
700
|
,xlab="",ylab="tmax (in degree C)")
|
701
|
y<-trans4_data$CAI[1:150]
|
702
|
lines(x,y,col="green")
|
703
|
abline(v=pos)#addlines whtere the stations area...
|
704
|
#plot(elev)
|
705
|
#title(title_plot[i]))
|
706
|
legend("topleft",legend=c("fus","CAI"),
|
707
|
cex=1.2, col=c("red","green"),
|
708
|
lty=1)
|
709
|
savePlot(paste("fig18a_transect_path_tmax_diff_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
|
710
|
|
711
|
|
712
|
y<-trans4_data$fus[151:300]
|
713
|
x <- 151:300
|
714
|
plot(x,y,type="l",col="red", #plotting fusion profile
|
715
|
,xlab="",ylab="tmax (in degree C)")
|
716
|
y<-trans4_data$CAI[151:300]
|
717
|
lines(x,y,col="green")
|
718
|
abline(v=pos)#addlines whtere the stations area...
|
719
|
#plot(elev)
|
720
|
#title(title_plot[i]))
|
721
|
legend("topleft",legend=c("fus","CAI"),
|
722
|
cex=1.2, col=c("red","green"),
|
723
|
lty=1)
|
724
|
savePlot(paste("fig18b_transect_path_tmax_diff_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
|
725
|
|
726
|
dev.off()
|
727
|
|
728
|
#cor(fus_y,elev_y)
|
729
|
#cor(cai_y,elev_y)
|
730
|
#cor(fus_y,cai_y)
|
731
|
|
732
|
}
|