Project

General

Profile

« Previous | Next » 

Revision 30f84063

Added by Benoit Parmentier about 12 years ago

Methods comp part5-task#491- initial commit, residuals analyses with focus on differences,land cover and covariates plots

View differences:

climate/research/oregon/interpolation/methods_comparison_assessment_part5.R
1
#####################################  METHODS COMPARISON part 5 ##########################################
2
#################################### Spatial Analysis ############################################
3
#This script utilizes the R ojbects created during the interpolation phase.                       #
4
#At this stage the script produces figures of various accuracy metrics and compare methods:       #
5
#This scripts focuses on a detailed studay of differences in the predictions of CAI_kr and FUsion_Kr                              #
6
#AUTHOR: Benoit Parmentier                                                                        #
7
#DATE: 11/23/2012                                                                                 #
8
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#491 --                                  #
9
###################################################################################################
10

  
11
###Loading R library and packages                                                      
12
library(gtools)                                        # loading some useful tools such as mixedsort
13
library(mgcv)                                           # GAM package by Wood 2006 (version 2012)
14
library(sp)                                             # Spatial pacakge with class definition by Bivand et al. 2008
15
library(spdep)                                          # Spatial package with methods and spatial stat. by Bivand et al. 2012
16
library(rgdal)                                          # GDAL wrapper for R, spatial utilities (Keitt et al. 2012)
17
library(gstat)                                          # Kriging and co-kriging by Pebesma et al. 2004
18
library(automap)                                        # Automated Kriging based on gstat module by Hiemstra et al. 2008
19
library(spgwr)
20
library(gpclib)
21
library(maptools)
22
library(graphics)
23
library(parallel)                            # Urbanek S. and Ripley B., package for multi cores & parralel processing
24
library(raster)
25
library(rasterVis)
26
library(plotrix)   #Draw circle on graph
27
library(reshape)
28
######### Functions used in the script
29
#loading R objects that might have similar names
30
load_obj <- function(f)
31
{
32
  env <- new.env()
33
  nm <- load(f, env)[1]
34
  env[[nm]]
35
}
36

  
37
plot_transect<-function(list_trans,r_stack,title_plot,disp=TRUE){
38
  #This function creates plot of transects for stack of raster images.
39
  #The parameters are:
40
  #list_trans: list of files containing the transects lines in shapefile format
41
  #r_stack: raster stack of files
42
  #title_plot: plot title
43
  #disp: dispaly and save from X11 if TRUE
44
  nb<-length(list_trans)
45
  t_col<-rainbow(nb)
46
  list_trans_data<-vector("list",nb)
47
  for (i in 1:nb){
48
    trans_file<-list_trans[[i]][1]
49
    filename<-sub(".shp","",trans_file)             #Removing the extension from file.
50
    transect<-readOGR(".", filename)                 #reading shapefile 
51
    trans_data<-extract(r_stack, transect)
52
    if (disp==FALSE){
53
      png(file=paste(list_trans[[i]]),".png",sep="")
54
    }
55
    for (k in 1:ncol(trans_data[[1]])){
56
      y<-trans_data[[1]][,k]
57
      x<-1:length(y)
58
      if (k!=1){
59
        lines(x,y,col=t_col[k])
60
      }
61
      if (k==1){
62
        plot(x,y,type="l",xlab="Position index", ylab="temperature",col=rainbow(k)) 
63
      }
64
    }
65
    title(title_plot[i])
66
    legend("topright",legend=layerNames(r_stack), 
67
           cex=1.2, col=t_col,
68
           lty=1)
69
    
70
    if (disp==TRUE){
71
      savePlot(file=paste(list_trans[[i]][2],".png",sep=""),type="png")
72
    }
73
    if (disp==FALSE){
74
      dev.off()
75
    }
76
    list_trans_data[[i]]<-trans_data
77
  }
78
  names(list_trans_data)<-names(list_trans)
79
  return(list_trans_data)
80
}
81

  
82
plot_transect_m<-function(list_trans,r_stack,title_plot,disp=TRUE,m_layers){
83
  #This function creates plot of transects for stack of raster images.
84
  #Arguments:
85
  #list_trans: list of files containing the transects lines in shapefile format
86
  #r_stack: raster stack containing the information to extect
87
  #title_plot: plot title
88
  #disp: display and save from X11 if TRUE or plot to png file if FALSE
89
  #m_layers: index for layerers containing alternate units to be drawned on a differnt scale
90
  #RETURN:
91
  #list containing transect information
92
  
93
  nb<-length(list_trans)
94
  t_col<-rainbow(nb)
95
  list_trans_data<-vector("list",nb)
96
  
97
  #For scale 1
98
  for (i in 1:nb){
99
    trans_file<-list_trans[[i]][1]
100
    filename<-sub(".shp","",trans_file)             #Removing the extension from file.
101
    transect<-readOGR(".", filename)                 #reading shapefile 
102
    trans_data<-extract(r_stack, transect)
103
    if (disp==FALSE){
104
      png(file=paste(list_trans[[i]]),".png",sep="")
105
    }
106
    #Plot layer values for specific transect
107
    for (k in 1:ncol(trans_data[[1]])){
108
      y<-trans_data[[1]][,k]
109
      x<-1:length(y)
110
      m<-match(k,m_layers)
111

  
112
      if (k==1 & is.na(m)){
113
        plot(x,y,type="l",xlab="Position index", ylab="temperature",col=t_col[k])
114
        axis(2,xlab="",ylab="tmax (in degree C)")
115
      }
116
      if (k==1 & !is.na(m)){
117
        plot(x,y,type="l",col=t_col[k],axes=F) #plotting fusion profile
118
        axis(4,xlab="",ylab="tmax (in degree C)")  
119
        
120
      }
121
      if (k!=1 & is.na(m)){
122
        #par(new=TRUE)              # new plot without erasing old
123
        lines(x,y,type="l",col=t_col[k],axes=F) #plotting fusion profile
124
        #axis(2,xlab="",ylab="tmax (in degree C)")
125
      }
126
      if (k!=1 & !is.na(m)){
127
        par(new=TRUE)              # key: ask for new plot without erasing old
128
        plot(x,y,type="l",col=t_col[k],axes=F) #plotting fusion profile
129
        #axis(4,xlab="",ylab="tmax (in degree C)")  
130
      }
131
      
132
    }
133
    title(title_plot[i])
134
    legend("topright",legend=layerNames(r_stack), 
135
           cex=1.2, col=t_col,
136
           lty=1)
137
    
138
    if (disp==TRUE){
139
      savePlot(file=paste(list_trans[[i]][2],".png",sep=""),type="png")
140
    }
141
    if (disp==FALSE){
142
      dev.off()
143
    }
144
    list_trans_data[[i]]<-trans_data
145
  }
146
  names(list_trans_data)<-names(list_trans)
147
  return(list_trans_data)
148
}
149

  
150
transect_from_spdf<-function (spdf,selected_features){
151
  #This function produces a transect from a set of selected points in a point layer
152
  # Arguments:
153
  # spdf: SpatialPointDataFrame
154
  # selected_features: index of ssubset points used in the transect line
155
  # Return: SpatialLinesDataframe object corresponding to the transect
156
  # Author: Benoit Parmentier
157
  # Date: 11-29-2012
158
  
159
  dat_id<-spdf[selected_features,]  #creating new subset from spdf
160
  spdf_proj<-proj4string(dat_id)
161
  matrix_point_coords<-coordinates(dat_id)
162
  #Add possibility of keeping attributes?
163
  #Transform a sequence of points with coords into Spatial Lines
164
  #Note that X is the ID, modify for dataframe?
165
  trans4<-SpatialLines(list(Lines(list(Line(coordinates(matrix_point_coords))),"X")))   
166
  tmp<-as.data.frame(dat_id[1,])
167
  row.names(tmp)<-rep("X",1)
168
  trans4<-SpatialLinesDataFrame(trans4,data=tmp)
169
  proj4string(trans4)<-spdf_proj
170
  return(trans4)
171
}
172

  
173
###Parameters and arguments
174

  
175
infile1<- "ghcn_or_tmax_covariates_06262012_OR83M.shp"    #GHCN shapefile containing variables for modeling 2010                 
176
#infile2<-"list_10_dates_04212012.txt"                    #List of 10 dates for the regression
177
infile2<-"list_365_dates_04212012.txt"                    #list of dates
178
infile3<-"LST_dates_var_names.txt"                        #LST dates name
179
infile4<-"models_interpolation_05142012.txt"              #Interpolation model names
180
infile5<-"mean_day244_rescaled.rst"                       #mean LST for day 244
181
inlistf<-"list_files_05032012.txt"                        #list of raster images containing the Covariates
182
infile6<-"OR83M_state_outline.shp"
183
#stat_loc<-read.table(paste(path,"/","location_study_area_OR_0602012.txt",sep=""),sep=",", header=TRUE)
184

  
185
out_prefix<-"methods_11292012_"
186
nb_transect<-4
187
##### LOAD USEFUL DATA
188

  
189
#obj_list<-"list_obj_08262012.txt"                                  #Results of fusion from the run on ATLAS
190
path<-"/home/parmentier/Data/IPLANT_project/methods_interpolation_comparison_10242012" #Jupiter LOCATION on Atlas for kriging                              #Jupiter Location on XANDERS
191
#path<-"/Users/benoitparmentier/Dropbox/Data/NCEAS/Oregon_covariates/"            #Local dropbox folder on Benoit's laptop
192
setwd(path) 
193
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";
194
#User defined output prefix
195

  
196
#CRS<-proj4string(ghcn)                       #Storing projection information (ellipsoid, datum,etc.)
197
lines<-read.table(paste(path,"/",inlistf,sep=""), sep="")                      #Column 1 contains the names of raster files
198
inlistvar<-lines[,1]
199
inlistvar<-paste(path,"/",as.character(inlistvar),sep="")
200
covar_names<-as.character(lines[,2])                                         #Column two contains short names for covaraites
201

  
202
s_raster<- stack(inlistvar)                                                  #Creating a stack of raster images from the list of variables.
203
layerNames(s_raster)<-covar_names                                            #Assigning names to the raster layers
204
projection(s_raster)<-proj_str
205

  
206
#Create mask using land cover data
207
pos<-match("LC10",layerNames(s_raster))            #Find the layer which contains water bodies
208
LC10<-subset(s_raster,pos)
209
LC10[is.na(LC10)]<-0                               #Since NA values are 0, we assign all zero to NA
210
mask_land<-LC10<100                                #All values below 100% water are assigned the value 1, value 0 is "water"
211
mask_land_NA<-mask_land                            
212
mask_land_NA[mask_land_NA==0]<-NA                  #Water bodies are assigned value 1
213

  
214
data_name<-"mask_land_OR"
215
raster_name<-paste(data_name,".rst", sep="")
216
writeRaster(mask_land, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
217
#writeRaster(r2, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
218

  
219
pos<-match("ELEV_SRTM",layerNames(s_raster)) #Find column with name "ELEV_SRTM"
220
ELEV_SRTM<-raster(s_raster,layer=pos)             #Select layer from stack on 10/30
221
s_raster<-dropLayer(s_raster,pos)
222
ELEV_SRTM[ELEV_SRTM <0]<-NA
223
mask_ELEV_SRTM<-ELEV_SRTM>0
224

  
225
#Change this a in loop...
226
pos<-match("LC1",layerNames(s_raster)) #Find column with name "value"
227
LC1<-raster(s_raster,layer=pos)             #Select layer from stack
228
s_raster<-dropLayer(s_raster,pos)
229
LC1[is.na(LC1)]<-0
230
pos<-match("LC2",layerNames(s_raster)) #Find column with name "value"
231
LC2<-raster(s_raster,layer=pos)             #Select layer from stack
232
s_raster<-dropLayer(s_raster,pos)
233
LC2[is.na(LC2)]<-0
234
pos<-match("LC3",layerNames(s_raster)) #Find column with name "value"
235
LC3<-raster(s_raster,layer=pos)             #Select layer from stack
236
s_raster<-dropLayer(s_raster,pos)
237
LC3[is.na(LC3)]<-0
238
pos<-match("LC4",layerNames(s_raster)) #Find column with name "value"
239
LC4<-raster(s_raster,layer=pos)             #Select layer from stack
240
s_raster<-dropLayer(s_raster,pos)
241
LC4[is.na(LC4)]<-0
242
pos<-match("LC6",layerNames(s_raster)) #Find column with name "value"
243
LC6<-raster(s_raster,layer=pos)             #Select layer from stack
244
s_raster<-dropLayer(s_raster,pos)
245
LC6[is.na(LC6)]<-0
246
pos<-match("LC7",layerNames(s_raster)) #Find column with name "value"
247
LC7<-raster(s_raster,layer=pos)             #Select layer from stack
248
s_raster<-dropLayer(s_raster,pos)
249
LC7[is.na(LC7)]<-0
250
pos<-match("LC9",layerNames(s_raster)) #Find column with name "LC9", this is wetland...
251
LC9<-raster(s_raster,layer=pos)             #Select layer from stack
252
s_raster<-dropLayer(s_raster,pos)
253
LC9[is.na(LC9)]<-0
254

  
255
LC_s<-stack(LC1,LC2,LC3,LC4,LC6,LC7)
256
layerNames(LC_s)<-c("LC1_forest","LC2_shrub","LC3_grass","LC4_crop","LC6_urban","LC7_barren")
257
LC_s <-mask(LC_s,mask_ELEV_SRTM)
258
plot(LC_s)
259

  
260
s_raster<-addLayer(s_raster, LC_s)
261

  
262
#mention this is the last... files
263

  
264
#Read region outline...
265
filename<-sub(".shp","",infile6)             #Removing the extension from file.
266
reg_outline<-readOGR(".", filename)                 #reading shapefile 
267

  
268
############ PART 4: RESIDUALS ANALYSIS: ranking, plots, focus regions  ##################
269
############## EXAMINING STATION RESIDUALS ###########
270
########### CONSTANT OVER 365 AND SAMPLING OVER 365
271
#Plot daily_deltaclim_rast, bias_rast,add data_s and data_v
272

  
273
# RANK STATION by average or median RMSE
274
# Count the number of times a station is in the extremum group of outliers...
275
# LOOK at specific date...
276

  
277
#Examine residuals for a spciefic date...Jan, 1 using run of const_all i.e. same training over 365 dates
278
path_data_cai<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations_10242012_CAI"  #Change to constant
279
path_data_fus<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations_10242012_GAM"
280

  
281
date_selected<-"20100103"
282

  
283
oldpath<-getwd()
284
setwd(path_data_cai)
285

  
286
################ VISUALIZATION !!!!!!!! ############
287
#updated the analysis
288

  
289
dates<-c("20100103","20100901")
290
i=2
291

  
292
for(i in 1:length(dates)){
293
  
294
  date_selected<-dates[i]
295
  oldpath<-getwd()
296
  setwd(path_data_cai)
297
  file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_CAI2_const_all_10312012.rst",sep="")) #Search for files in relation to fusion                  
298
  lf_cai2c<-list.files(pattern=file_pat) #Search for files in relation to fusion                  
299
  rast_cai2c<-stack(lf_cai2c)                   #lf_cai2c CAI results with constant sampling over 365 dates
300
  rast_cai2c<-mask(rast_cai2c,mask_ELEV_SRTM)
301
  
302
  oldpath<-getwd()
303
  setwd(path_data_fus)
304
  file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_fusion_const_all_lstd_11022012.rst",sep="")) #Search for files in relation to fusion                  
305
  lf_fus1c<-list.files(pattern=file_pat) #Search for files in relation to fusion                        
306
  rast_fus1c<-stack(lf_fus1c)
307
  rast_fus1c<-mask(rast_fus1c,mask_ELEV_SRTM)
308
  
309
  #PLOT ALL MODELS
310
  #Prepare for plotting
311

  
312
  setwd(path) #set path to the output path
313
  
314
  s_range<-c(minValue(rast_fus1c),maxValue(rast_fus1c)) #stack min and max
315
  s_range<-c(min(s_range),max(s_range))
316
  col_breaks <- pretty(s_range, n=50)
317
  lab_breaks <- pretty(s_range, n=5)
318
  temp_colors <- colorRampPalette(c('blue', 'white', 'red'))
319
  X11(width=18,height=12)
320
  par(mfrow=c(3,3))
321
  for (k in 1:length(lf_fus1c)){
322
    fus1c_r<-raster(rast_fus1c,k)
323
    plot(fus1c_r, breaks=col_breaks, col=temp_colors(length(col_breaks)-1),   
324
         axis=list(at=lab_breaks, labels=lab_breaks))
325
  }
326
  plot(rast_fus1c,col=temp_colors(49))
327
  savePlot(paste("fig1_diff_models_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
328
  dev.off()
329
  s_range<-c(minValue(rast_cai2c),maxValue(rast_cai2c)) #stack min and max
330
  s_range<-c(min(s_range),max(s_range))
331
  col_breaks <- pretty(s_range, n=50)
332
  lab_breaks <- pretty(s_range, n=5)
333
  temp_colors <- colorRampPalette(c('blue', 'white', 'red'))
334
  X11(width=18,height=12)
335
  par(mfrow=c(3,3))
336
  for (k in 1:length(lf_fus1c)){
337
    cai2c_r<-raster(rast_cai2c,k)
338
    plot(cai2c_r, breaks=col_breaks, col=temp_colors(length(col_breaks)-1),   
339
         axis=list(at=lab_breaks, labels=lab_breaks))
340
  }
341
  plot(rast_cai2c,col=temp_colors(49))
342
  savePlot(paste("fig2_diff_models_cai_",date_selected,out_prefix,".png", sep=""), type="png")
343
  dev.off()
344
  #PLOT CAI_Kr and Fusion_Kr
345
  
346
  rast_fus_pred<-raster(rast_fus1c,1)  # Select the first model from the stack i.e fusion with kriging for both steps
347
  rast_cai_pred<-raster(rast_cai2c,1)  
348
  layerNames(rast_cai_pred)<-paste("cai",date_selected,sep="_")
349
  layerNames(rast_fus_pred)<-paste("fus",date_selected,sep="_")
350
  #Plot side by side
351
  X11(width=16,height=9)
352
  rast_pred<-stack(rast_cai_pred,rast_fus_pred)
353
  layerNames(rast_pred)<-c(paste('CAI_kr',date_selected,sep=" "),paste('Fusion_kr',date_selected,sep=" "))
354
  s.range <- c(min(minValue(rast_pred)), max(maxValue(rast_pred)))
355
  col.breaks <- pretty(s.range, n=50)
356
  lab.breaks <- pretty(s.range, n=5)
357
  temp.colors <- colorRampPalette(c('blue', 'white', 'red'))
358
  plot(rast_pred, breaks=col.breaks, col=temp.colors(length(col.breaks)-1),
359
       axis=list(at=lab.breaks, labels=lab.breaks))
360
  savePlot(paste("fig3_diff_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
361
  
362
  #Scatter plot of fus vs cai
363
  plot(values(rast_fus_pred),values(rast_cai_pred),ylab="CAI",xlab="Fusion",axis=FALSE)
364
  title(paste("CAI and fusion scatterplot on ",date_selected,sep=""))
365
  savePlot(paste("fig4_diff_image_scatterplot_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
366
  dev.off()
367
  
368
  ## Start difference analysis
369
  #Calculate difference image for the date selected 
370
  rast_diff<-rast_fus_pred-rast_cai_pred
371
  layerNames(rast_diff)<-paste("diff",date_selected,sep="_")
372
  mean_val<-cellStats(rast_diff,mean)
373
  sd_val<-cellStats(rast_diff,sd)
374
  
375
  #View classified diff and outliers... 
376
  diff_n_outlier<-rast_diff< (2*-sd_val) #Create negative and positive outliers...
377
  diff_p_outlier<-rast_diff> (2*sd_val) #Create negative and positive outliers...
378
  diff_outlier<-stack(diff_n_outlier,diff_p_outlier)
379
  layerNames(diff_outlier)<-c("Negative_diff_outliers","Positive_diff_outliers")
380
  bool_ramp<-colorRampPalette(c("black","red"))
381
  X11()
382
  plot(diff_outlier,col=bool_ramp(2))
383
  savePlot(paste("fig5_diff_image_outliers_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
384
  dev.off()
385
  tmp<-overlay(diff_n_outlier,ELEV_SRTM,fun=function(x,y){return(x*y)})
386
  #could use mask
387
  tmp[tmp==0]<-NA
388
  mean_Elev_n_outliers<-cellStats(tmp,mean)
389
  mean_Elev<-cellStats(ELEV_SRTM,mean)
390
  print(c(mean_Elev_n_outliers,mean_Elev),digits=7) #This shows that outliers are in higher areas
391
  # on average: 1691m compared to 1044m
392
  ##postive outliers and land cover
393
  #LC2 (shrub), LC1(forest),LC3(grass),LC4(crop)
394
  tmp<-overlay(diff_p_outlier,LC2,fun=function(x,y){return(x*y)})
395
  tmp[tmp==0]<-NA
396
  mean_LC2_p_outliers<-cellStats(tmp,mean)  #There is more shrub (44.84% than on average 22.32)
397
  mean_LC2<-cellStats(LC2,mean)
398
  print(c(mean_LC2_p_outliers,mean_LC2),digits=7) #This shows that outliers have in higher 
399
  #proportion of shurb (44% against 25%)
400
  tmp<-overlay(diff_p_outlier,LC3,fun=function(x,y){return(x*y)})
401
  tmp[tmp==0]<-NA
402
  mean_LC3_p_outliers<-cellStats(tmp,mean)  #There is more grass (42.73% than on average 14.47)
403
  mean_LC3<-cellStats(LC3,mean)
404
  print(c(mean_LC3_p_outliers,mean_LC3),digits=7) #This shows that outliers have in higher 
405
  #proportion of shurb (44% against 25%)
406
  tmp<-overlay(diff_p_outlier,LC4,fun=function(x,y){return(x*y)})
407
  tmp[tmp==0]<-NA
408
  mean_LC4_p_outliers<-cellStats(tmp,mean)  #There is more grass (42.73% than on average 14.47)
409
  mean_LC4<-cellStats(LC4,mean)
410
  print(c(mean_LC4_p_outliers,mean_LC4),digits=7) #This shows that outliers have in higher 
411
  
412
  #CREATE A TABLE
413
  
414
  ####
415
  #View histogram
416
  hist(rast_diff)
417
  
418
  ### More Land cover analysis related to references...
419
  
420
  LC2<-mask(LC2,mask_ELEV_SRTM)
421
  cellStats(LC2,"countNA")        #Check that NA have been assigned to water and areas below 0 m
422
  
423
  LC2_50_m<- LC2>50
424
  
425
  LC2_50<-LC2_50_m*LC2
426
  diff_LC2_50<-LC2_50_m*rast_diff
427
  cellStats(diff_LC2_50,"mean")
428
  plot(LC2)
429
  plot(LC2_50)
430
  freq(LC2_50)
431
  
432
  #Forest NOW
433
  LC1<-mask(LC1,mask_ELEV_SRTM)
434
  cellStats(LC1,"countNA")        #Check that NA have been assigned to water and areas below 0 m
435
  
436
  LC1_50_m<- LC1>50
437
  LC1_100_m<- LC1>=100
438
  LC1_50_m[LC1_50_m==0]<-NA
439
  LC1_100_m[LC1_100_m==0]<-NA
440
  LC1_50<-LC1_50_m*LC1
441
  LC1_100<-LC1_100_m*LC1
442
  plot(LC1)
443
  plot(LC1_50_m)
444
  freq(LC1_50_m)
445
  diff_LC1_50<-LC1_50_m*rast_diff
446
  diff_LC1_100<-LC1_100_m*rast_diff
447
  
448
  plot(diff_LC1_50)
449
  cellStats(diff_LC1_50,"mean")
450
  cellStats(diff_LC1_100,"mean")
451
  plot(values(diff_LC1_50),values(LC1_50))
452
  plot(values(diff_LC1_100),values(LC1_100))
453
  x<-brick(LC1,rast_diff)
454
  
455
  #Summarize results using plot
456
  #LC1 and LC3 and LC4
457
  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!!
458
  rclmat<-matrix(avl,ncol=3,byrow=TRUE)
459
  LC1_rec<-reclass(LC1,rclmat)  #Loss of layer names when using reclass
460
  LC2_rec<-reclass(LC2,rclmat)  #Loss of layer names when using reclass
461
  LC3_rec<-reclass(LC3,rclmat)  #Loss of layer names when using reclass
462
  LC4_rec<-reclass(LC4,rclmat)  #Loss of layer names when using reclass
463
  LC6_rec<-reclass(LC6,rclmat)  #Loss of layer names when using reclass
464
  
465
  #LC_s<-stack(LC1,LC3,LC4,LC6)
466
  LC_s<-stack(LC1,LC2,LC3,LC4,LC6)
467
  layerNames(LC_s)<-c("LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban")
468
  LC_s<-mask(LC_s,mask_ELEV_SRTM)
469
  LC_rec_s<-reclass(LC_s,rclmat)
470
  
471
  #plot average difference per class of forest and LC2
472
  rast_stack_zones<-LC_rec_s
473
  
474
  avg_LC1_rec<-zonal(rast_diff,zones=LC1_rec,stat="mean",na.rm=TRUE)
475
  avg_LC2_rec<-zonal(rast_diff,zones=LC2_rec,stat="mean",na.rm=TRUE)
476
  avg_LC3_rec<-zonal(rast_diff,zones=LC3_rec,stat="mean",na.rm=TRUE)
477
  avg_LC4_rec<-zonal(rast_diff,zones=LC4_rec,stat="mean",na.rm=TRUE)
478
  avg_LC6_rec<-zonal(rast_diff,zones=LC6_rec,stat="mean",na.rm=TRUE)
479
  
480
  std_LC1_rec<-zonal(rast_diff,zones=LC1_rec,stat="sd",na.rm=TRUE)
481
  std_LC2_rec<-zonal(rast_diff,zones=LC2_rec,stat="sd",na.rm=TRUE)
482
  std_LC3_rec<-zonal(rast_diff,zones=LC3_rec,stat="sd",na.rm=TRUE)
483
  std_LC4_rec<-zonal(rast_diff,zones=LC4_rec,stat="sd",na.rm=TRUE)
484
  std_LC6_rec<-zonal(rast_diff,zones=LC6_rec,stat="sd",na.rm=TRUE)
485
  
486
  avg_LC_rec<-zonal(rast_diff,zones=LC_rec_s,stat="mean",na.rm=TRUE)
487
  std_LC_rec<-zonal(rast_diff,zones=LC_rec_s,stat="sd",na.rm=TRUE)
488
  
489
  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]))
490
  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]))
491
  names(zones_stat)<-c("zones","LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban")
492
  names(zones_stat_std)<-c("zones","LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban")
493
  
494
  X11()
495
  plot(zones_stat$zones,zones_stat$LC1_forest,type="b",ylim=c(-4.5,4.5),
496
       ylab="difference between CAI and fusion",xlab="land cover percent class/10")
497
  lines(zones_stat$zones,zones_stat[,3],col="red",type="b")
498
  lines(zones_stat$zones,zones_stat[,4],col="blue",type="b")
499
  lines(zones_stat$zones,zones_stat[,5],col="darkgreen",type="b")
500
  lines(zones_stat$zones,zones_stat[,6],col="purple",type="b")
501
  legend("topleft",legend=c("LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban"), 
502
         cex=1.2, col=c("black","red","blue","darkgreen","purple"),
503
         lty=1)
504
  title(paste("Prediction tmax difference and land cover ",sep=""))
505
  
506
  savePlot(paste("fig6_diff_prediction_tmax_difference_land cover",date_selected,out_prefix,".png", sep=""), type="png")
507
  dev.off()
508
  
509
  avl<-c(0,500,1,500,1000,2,1000,1500,3,1500,2000,4,2000,2500,5,2500,4000,6)
510
  rclmat<-matrix(avl,ncol=3,byrow=TRUE)
511
  elev_rec<-reclass(ELEV_SRTM,rclmat)  #Loss of layer names when using reclass
512
  
513
  elev_rec_forest<-elev_rec*LC1_100_m
514
  avg_elev_rec<-zonal(rast_diff,zones=elev_rec,stat="mean",na.rm=TRUE)
515
  std_elev_rec<-zonal(rast_diff,zones=elev_rec,stat="sd",na.rm=TRUE)
516
  avg_elev_rec_forest<-zonal(rast_diff,zones=elev_rec_forest,stat="mean",na.rm=TRUE)
517
  std_elev_rec_forest<-zonal(rast_diff,zones=elev_rec_forest,stat="sd",na.rm=TRUE)
518
  
519
  
520
  
521
  ## CREATE plots
522
  X11()
523
  plot(avg_elev_rec[,1],avg_elev_rec[,2],type="b",ylim=c(-10,1),
524
       ylab="difference between CAI and fusion",xlab="elevation classes")
525
  lines(avg_elev_rec_forest[,1],avg_elev_rec_forest[,2],col="green",type="b") #Elevation and 100% forest...
526
  legend("topright",legend=c("Elevation", "elev_forest"), 
527
         cex=1.2, col=c("black","darkgreen"),
528
         lty=1)
529
  title(paste("Prediction tmax difference and elevation ",sep=""))
530
  savePlot(paste("fig7_diff_prediction_tmax_difference_elevation",date_selected,out_prefix,".png", sep=""), type="png")
531
  dev.off()
532
  #Add plots with std as CI
533
   
534
}
535

  
536
###################################################################
537
################   TRANSECT THROUGH THE IMAGE: ####################
538

  
539
#select date
540
dates<-c("20100103","20100901")
541
j=1
542

  
543
for (j in 1:length(dates)){
544
  
545
  #Read predicted tmax raster surface and modeling information
546
  date_selected<-dates[j]
547
  oldpath<-getwd()
548
  setwd(path_data_cai)
549
  file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_CAI2_const_all_10312012.rst",sep="")) #Search for files in relation to fusion                  
550
  lf_cai2c<-list.files(pattern=file_pat) #Search for files in relation to fusion                  
551
  rast_cai2c<-stack(lf_cai2c)                   #lf_cai2c CAI results with constant sampling over 365 dates
552
  rast_cai2c<-mask(rast_cai2c,mask_ELEV_SRTM)
553
  
554
  oldpath<-getwd()
555
  setwd(path_data_fus)
556
  file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_fusion_const_all_lstd_11022012.rst",sep="")) #Search for files in relation to fusion                  
557
  lf_fus1c<-list.files(pattern=file_pat) #Search for files in relation to fusion                        
558
  rast_fus1c<-stack(lf_fus1c)
559
  rast_fus1c<-mask(rast_fus1c,mask_ELEV_SRTM)
560
  
561
  setwd(path)
562
  rast_fus_pred<-raster(rast_fus1c,1)
563
  rast_cai_pred<-raster(rast_cai2c,1)
564
  rast_diff_fc<-rast_fus_pred-rast_cai_pred
565
  #Read in data_s and data_v
566
  
567
  
568
  ### CREATE A NEW TRANSECT BASED ON LOCATION OF SPECIFIED STATIONS
569
  
570
  selected_stations<-c("USW00024284","USC00354126","USC00358536","USC00354835",
571
                       "USC00356252","USC00359316","USC00358246","USC00350694",
572
                       "USC00350699","USW00024230","USC00353542")
573
  #add which one were training and testing
574
  data_vf$training<-rep(0,nrow(data_vf))
575
  data_sf$training<-rep(1,nrow(data_sf))
576
  
577
  data_stat<-rbind(data_vf[,c("id","training")],data_sf[,c("id","training")])
578
  m<-match(selected_stations,data_stat$id)
579
  
580
  trans4_stations<-transect_from_spdf(data_stat,m)
581
  #tmp<-as.data.frame(data_stat[1,])
582
  #row.names(tmp)<-rep("X",1)
583
  #test<-SpatialLinesDataFrame(trans4_stations,data=tmp)
584
  writeOGR(obj=trans4_stations,layer="t4_line",dsn="t4_line.shp",driver="ESRI Shapefile", overwrite=T)
585
  ## Create list of transect
586
  
587
  list_transect<-vector("list",nb_transect)
588
  list_transect[[1]]<-c("t1_line.shp",paste("figure_9_tmax_transect1_OR",date_selected,out_prefix,sep="_"))
589
  list_transect[[2]]<-c("t2_line.shp",paste("figure_10_tmax_transect2_OR",date_selected,out_prefix,sep="_"))
590
  list_transect[[3]]<-c("t3_line.shp",paste("figure_11_tmax_transect3_OR",date_selected,out_prefix,sep="_"))
591
  list_transect[[4]]<-c("t4_line.shp",paste("figure_12_tmax_transect4_OR",date_selected,out_prefix,sep="_"))
592
  
593
  names(list_transect)<-c("transect_OR1","transect_OR2","transect_OR3","transect_OR4")
594
  
595
  #now add a transect for elevation
596
  list_transect2<-vector("list",nb_transect)
597
  list_transect2[[1]]<-c("t1_line.shp",paste("figure_13_tmax_elevation_transect1_OR",date_selected,out_prefix,sep="_"))
598
  list_transect2[[2]]<-c("t2_line.shp",paste("figure_14_tmax_elevation_transect2_OR",date_selected,out_prefix,sep="_"))
599
  list_transect2[[3]]<-c("t3_line.shp",paste("figure_15_tmax_elevation_transect3_OR",date_selected,out_prefix,sep="_"))
600
  list_transect2[[4]]<-c("t4_line.shp",paste("figure_16_tmax_elevation_transect3_OR",date_selected,out_prefix,sep="_"))
601
  
602
  names(list_transect2)<-c("transect_OR1","transect_OR2","transect_OR3","transect_OR4")
603
  
604
  rast_pred<-stack(rast_fus_pred,rast_cai_pred)
605
  rast_pred2<-stack(rast_fus_pred,rast_cai_pred,ELEV_SRTM)
606
  layerNames(rast_pred)<-c("fus","CAI")
607
  layerNames(rast_pred2)<-c("fus","CAI","elev")
608
  title_plot<-paste(names(list_transect),date_selected)
609
  title_plot2<-paste(names(list_transect2),date_selected)
610
  #r_stack<-rast_pred
611
  
612
  X11(width=9,height=9)
613
  nb_transect<-length(list_transect)
614
  s_range<-c(minValue(rast_diff_fc),maxValue(rast_diff_fc)) #stack min and max
615
  col_breaks <- pretty(s_range, n=50)
616
  lab_breaks <- pretty(s_range, n=7)
617
  temp_colors <- colorRampPalette(c('blue', 'white', 'red'))
618
  plot(rast_diff_fc, breaks=col_breaks, col=temp_colors(length(col_breaks)-1),   
619
         axis=list(at=lab_breaks, labels=lab_breaks))
620
  for (k in 1:nb_transect){
621
    trans_file<-list_transect[[k]]
622
    filename<-sub(".shp","",trans_file)             #Removing the extension from file.
623
    transect<-readOGR(".", filename)                 #reading shapefile 
624
    plot(transect,add=TRUE)
625
  }
626

  
627
  savePlot(paste("fig8_diff_transect_path_tmax_diff_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png")
628
  dev.off()
629
  
630
  X11(width=18,height=9)
631
  m_layers_sc<-c(3)
632
  trans_data<-plot_transect(list_transect,rast_pred,title_plot,disp=TRUE)
633
  
634
  trans_data2<-plot_transect_m(list_transect2,rast_pred2,title_plot2,disp=TRUE,m_layers_sc)
635
  dev.off()
636
  
637
  
638
  X11(width=18,height=9) 
639
  trans_elev<-vector("list",nb_transect)
640
  for (k in 1:nb_transect){
641
    
642
    trans_file<-list_transect[[k]]
643
    filename<-sub(".shp","",trans_file)             #Removing the extension from file.
644
    transect<-readOGR(".", filename)                 #reading shapefile 
645
    trans_elev[[k]]<-extract(ELEV_SRTM,transect)  
646
    y<-as.numeric(trans_elev[[k]][[1]])
647
    elev_y<-y
648
    x<-1:length(y)
649
    plot(x,y,type="l", ylab="Elevation (in meters)",xlab="Transect position (in km)")
650
    data_y<-(trans_data[[k]][[1]])  # data for the first transect
651
    #as.data.frame(data_y)
652
    par(new=TRUE)              # key: ask for new plot without erasing old
653
    y<-data_y[,1]
654
    x <- 1:length(y)
655
    fus_y<-y
656
    plot(x,y,type="l",col="red",axes=F) #plotting fusion profile
657
    axis(4,xlab="",ylab="tmax (in degree C)")
658
    y<-data_y[,2]
659
    cai_y<-y
660
    lines(x,y,col="green")
661
    
662
    #title(title_plot[i]))
663
    legend("topleft",legend=c("elev","fus","CAI"), 
664
         cex=1.2, col=c("black","red","green"),
665
         lty=1)
666
    savePlot(file=paste(list_transect[[k]][2],".png",sep=""),type="png")
667
    
668
    cor(fus_y,elev_y)
669
    cor(cai_y,elev_y)
670
    cor(fus_y,cai_y)
671
  }
672
  dev.off
673

  
674
}

Also available in: Unified diff