Project

General

Profile

« Previous | Next » 

Revision 4719fdd7

Added by Benoit Parmentier over 12 years ago

GAM FUSION, multi sampling function initial commit

View differences:

climate/research/oregon/interpolation/GAM_fusion_function_multisampling.R
1
runGAMFusion <- function(i) {            # loop over dates
2
  
3
  #date<-strptime(dates[i], "%Y%m%d")   # interpolation date being processed
4
  date<-strptime(sampling_dat$date[i], "%Y%m%d")   # interpolation date being processed
5
  
6
  month<-strftime(date, "%m")          # current month of the date being processed
7
  LST_month<-paste("mm_",month,sep="") # name of LST month to be matched
8
  
9
  #Adding layer LST to the raster stack
10
  
11
  pos<-match(LST_month,layerNames(s_raster)) #Find column with the current month for instance mm12
12
  r1<-raster(s_raster,layer=pos)             #Select layer from stack
13
  layerNames(r1)<-"LST"
14
  s_raster<-addLayer(s_raster,r1)            #Adding current month
15
  
16
  ###Regression part 1: Creating a validation dataset by creating training and testing datasets
17
  
18
  mod_LST <-ghcn.subsets[[i]][,match(LST_month, names(ghcn.subsets[[i]]))]  #Match interpolation date and monthly LST average
19
  ghcn.subsets[[i]] = transform(ghcn.subsets[[i]],LST = mod_LST)            #Add the variable LST to the subset dataset
20
  #n<-nrow(ghcn.subsets[[i]])
21
  #ns<-n-round(n*prop)   #Create a sample from the data frame with 70% of the rows
22
  #nv<-n-ns              #create a sample for validation with prop of the rows
23
  #ind.training <- sample(nrow(ghcn.subsets[[i]]), size=ns, replace=FALSE) #This selects the index position for 70% of the rows taken randomly
24
  ind.training<-sampling[[i]]
25
  ind.testing <- setdiff(1:nrow(ghcn.subsets[[i]]), ind.training)
26
  data_s <- ghcn.subsets[[i]][ind.training, ]   #Training dataset currently used in the modeling
27
  data_v <- ghcn.subsets[[i]][ind.testing, ]    #Testing/validation dataset using input sampling
28
  
29
  ns<-nrow(data_s)
30
  nv<-nrow(data_v)
31
  #i=1
32
  date_proc<-sampling_dat$date[i]
33
  date_proc<-strptime(sampling_dat$date[i], "%Y%m%d")   # interpolation date being processed
34
  mo<-as.integer(strftime(date_proc, "%m"))          # current month of the date being processed
35
  day<-as.integer(strftime(date_proc, "%d"))
36
  year<-as.integer(strftime(date_proc, "%Y"))
37

  
38
  datelabel=format(ISOdate(year,mo,day),"%b %d, %Y")
39
  
40
  ###########
41
  #  STEP 1 - LST 10 year monthly averages
42
  ###########
43

  
44
  themolst<-raster(molst,mo) #current month being processed saved in a raster image
45
  plot(themolst)
46
  
47
  ###########
48
  # STEP 2 - Weather station means across same days: Monthly mean calculation
49
  ###########
50
  
51
  modst=dst[dst$month==mo,] #Subsetting dataset for the relevant month of the date being processed
52
  
53
  ##########
54
  # STEP 3 - get LST at stations
55
  ##########
56
  
57
  sta_lola=modst[,c("lon","lat")] #Extracting locations of stations for the current month..
58
  
59
  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";
60
  lookup<-function(r,lat,lon) {
61
    xy<-project(cbind(lon,lat),proj_str);
62
    cidx<-cellFromXY(r,xy);
63
    return(r[cidx])
64
  }
65
  sta_tmax_from_lst=lookup(themolst,sta_lola$lat,sta_lola$lon) #Extracted values of LST for the stations
66
  
67
  #########
68
  # STEP 4 - bias at stations     
69
  #########
70
  
71
  sta_bias=sta_tmax_from_lst-modst$TMax; #That is the difference between the monthly LST mean and monthly station mean
72
  #Added by Benoit
73
  modst$LSTD_bias<-sta_bias  #Adding bias to data frame modst containning the monthly average for 10 years
74
  
75
  bias_xy=project(as.matrix(sta_lola),proj_str)
76
  png(paste("LST_TMax_scatterplot_",sampling_dat$date[i],"_",sampling_dat$prop[i],"_",sampling_dat$run_samp[i], out_prefix,".png", sep=""))
77
  plot(modst$TMax,sta_tmax_from_lst,xlab="Station mo Tmax",ylab="LST mo Tmax",main=paste("LST vs TMax for",datelabel,sep=" "))
78
  abline(0,1)
79
  dev.off()
80
  
81
  #added by Benoit 
82
  #x<-ghcn.subsets[[i]]  #Holds both training and testing for instance 161 rows for Jan 1
83
  x<-data_v
84
  d<-data_s
85
  
86
  pos<-match("value",names(d)) #Find column with name "value"
87
  #names(d)[pos]<-c("dailyTmax")
88
  names(d)[pos]<-y_var_name
89
  names(x)[pos]<-y_var_name
90
  #names(x)[pos]<-c("dailyTmax")
91
  d$dailyTmax=(as.numeric(d$dailyTmax))/10 #stored as 1/10 degree C to allow integer storage
92
  x$dailyTmax=(as.numeric(x$dailyTmax))/10 #stored as 1/10 degree C to allow integer storage
93
  pos<-match("station",names(d)) #Find column with name "value"
94
  names(d)[pos]<-c("id")
95
  names(x)[pos]<-c("id")
96
  names(modst)[1]<-c("id")       #modst contains the average tmax per month for every stations...
97
  dmoday=merge(modst,d,by="id")  #LOOSING DATA HERE!!! from 113 t0 103
98
  xmoday=merge(modst,x,by="id")  #LOOSING DATA HERE!!! from 48 t0 43
99
  names(dmoday)[4]<-c("lat")
100
  names(dmoday)[5]<-c("lon")     #dmoday contains all the the information: BIAS, monn
101
  names(xmoday)[4]<-c("lat")
102
  names(xmoday)[5]<-c("lon")     #dmoday contains all the the information: BIAS, monn
103
  
104
  data_v<-xmoday
105
  ###
106
  
107
  #dmoday contains the daily tmax values for training with TMax being the monthly station tmax mean
108
  #xmoday contains the daily tmax values for validation with TMax being the monthly station tmax mean
109
  
110
  # windows()
111
  #png(paste("LST_TMax_scatterplot_",sampling_dat$date[i],out_prefix,".png", sep=""))
112
  png(paste("Daily_tmax_monthly_TMax_scatterplot_",sampling_dat$date[i],"_",sampling_dat$prop[i],
113
            "_",sampling_dat$run_samp[i],out_prefix,".png", sep=""))
114
  plot(dailyTmax~TMax,data=dmoday,xlab="Mo Tmax",ylab=paste("Daily for",datelabel),main="across stations in OR")
115
  #savePlot(paste("Daily_tmax_monthly_TMax_scatterplot_",sampling_dat$date[i],out_prefix,".png", sep=""), type="png")
116
  #png(paste("LST_TMax_scatterplot_",sampling_dat$date[i],out_prefix,".png", sep=""))
117
  dev.off()
118
  
119
  ########
120
  # STEP 5 - interpolate bias
121
  ########
122
  
123
  # ?? include covariates like elev, distance to coast, cloud frequency, tree height
124
  #library(fields)
125
  #windows()
126
  quilt.plot(sta_lola,sta_bias,main="Bias at stations",asp=1)
127
  US(add=T,col="magenta",lwd=2)
128
  #fitbias<-Tps(bias_xy,sta_bias) #use TPS or krige
129
  
130
  #Adding options to use only training stations: 07/11/2012
131
  bias_xy=project(as.matrix(sta_lola),proj_str)
132
  #bias_xy2=project(as.matrix(c(dmoday$lon,dmoday$lat),proj_str)
133
  if(bias_val==1){
134
    sta_bias<-dmoday$LSTD_bias
135
    bias_xy<-cbind(dmoday$x_OR83M,dmoday$y_OR83M)
136
  }
137
  
138
  fitbias<-Krig(bias_xy,sta_bias,theta=1e5) #use TPS or krige 
139
  #The output is a krig object using fields
140
  mod9a<-fitbias
141
  # Creating plot of bias surface and saving it
142
  #X11()
143
  png(paste("Bias_surface_LST_TMax_",sampling_dat$date[i],"_",sampling_dat$prop[i],
144
            "_",sampling_dat$run_samp[i],out_prefix,".png", sep="")) #Create file to write a plot
145
  datelabel2=format(ISOdate(year,mo,day),"%B ") #added by Benoit, label
146
  surface(fitbias,col=rev(terrain.colors(100)),asp=1,main=paste("Interpolated bias for",datelabel2,sep=" ")) #Plot to file
147
  #savePlot(paste("Bias_surface_LST_TMax_",sampling_dat$date[i],out_prefix,".png", sep=""), type="png")
148
  dev.off()  #Release the hold to the file
149
  
150
  #US(add=T,col="magenta",lwd=2)
151
  
152
  ##########
153
  # STEP 7 - interpolate delta across space
154
  ##########
155
  
156
  daily_sta_lola=dmoday[,c("lon","lat")] #could be same as before but why assume merge does this - assume not
157
  daily_sta_xy=project(as.matrix(daily_sta_lola),proj_str)
158
  daily_delta=dmoday$dailyTmax-dmoday$TMax
159
  #windows()
160
  quilt.plot(daily_sta_lola,daily_delta,asp=1,main="Station delta for Jan 15")
161
  US(add=T,col="magenta",lwd=2)
162
  #fitdelta<-Tps(daily_sta_xy,daily_delta) #use TPS or krige
163
  fitdelta<-Krig(daily_sta_xy,daily_delta,theta=1e5) #use TPS or krige
164
  #Kriging using fields package
165
  mod9b<-fitdelta
166
  # Creating plot of bias surface and saving it
167
  #X11()
168
  png(paste("Delta_surface_LST_TMax_",sampling_dat$date[i],"_",sampling_dat$prop[i],
169
            "_",sampling_dat$run_samp[i],out_prefix,".png", sep=""))
170
  surface(fitdelta,col=rev(terrain.colors(100)),asp=1,main=paste("Interpolated delta for",datelabel,sep=" "))
171
  #savePlot(paste("Delta_surface_LST_TMax_",sampling_dat$date[i],out_prefix,".png", sep=""), type="png")
172
  dev.off()
173
  #US(add=T,col="magenta",lwd=2)
174
  #
175
  
176
  #### Added by Benoit on 06/19
177
  data_s<-dmoday #put the 
178
  data_s$daily_delta<-daily_delta
179
  
180
  #data_s$y_var<-daily_delta  #y_var is the variable currently being modeled, may be better with BIAS!!
181
  #data_s$y_var<-data_s$LSTD_bias
182
  #### Added by Benoit ends
183
  
184
  #########
185
  # STEP 8 - assemble final answer - T=LST+Bias(interpolated)+delta(interpolated)
186
  #########
187

  
188
  bias_rast=interpolate(themolst,fitbias) #interpolation using function from raster package
189
  #themolst is raster layer, fitbias is "Krig" object from bias surface
190
  #plot(bias_rast,main="Raster bias") #This not displaying...
191
  
192
  #Saving kriged surface in raster images
193
  data_name<-paste("bias_LST_",sampling_dat$date[i],"_",sampling_dat$prop[i],
194
                   "_",sampling_dat$run_samp[i],sep="")
195
  raster_name<-paste("fusion_",data_name,out_prefix,".rst", sep="")
196
  writeRaster(bias_rast, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
197
  
198
  daily_delta_rast=interpolate(themolst,fitdelta) #Interpolation of the bias surface...
199
  
200
  #plot(daily_delta_rast,main="Raster Daily Delta")
201
  
202
  #Saving kriged surface in raster images
203
  data_name<-paste("daily_delta_",sampling_dat$date[i],"_",sampling_dat$prop[i],
204
                   "_",sampling_dat$run_samp[i],sep="")
205
  raster_name<-paste("fusion_",data_name,out_prefix,".rst", sep="")
206
  writeRaster(daily_delta_rast, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
207
  
208
  tmax_predicted=themolst+daily_delta_rast-bias_rast #Final surface  as a raster layer...
209
  #tmax_predicted=themolst+daily_delta_rast+bias_rast #Added by Benoit, why is it -bias_rast
210
  #plot(tmax_predicted,main="Predicted daily")
211
  
212
  #Saving kriged surface in raster images
213
  data_name<-paste("tmax_predicted_",sampling_dat$date[i],"_",sampling_dat$prop[i],
214
                   "_",sampling_dat$run_samp[i],sep="")
215
  raster_name<-paste("fusion_",data_name,out_prefix,".rst", sep="")
216
  writeRaster(tmax_predicted, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
217
  
218
  ########
219
  # check: assessment of results: validation
220
  ########
221
  RMSE<-function(x,y) {return(mean((x-y)^2)^0.5)}
222
  MAE_fun<-function(x,y) {return(mean(abs(x-y)))}
223
  #ME_fun<-function(x,y){return(mean(abs(y)))}
224
  #FIT ASSESSMENT
225
  sta_pred_data_s=lookup(tmax_predicted,data_s$lat,data_s$lon)
226
  rmse_fit=RMSE(sta_pred_data_s,data_s$dailyTmax)
227
  mae_fit=MAE_fun(sta_pred_data_s,data_s$dailyTmax)
228
    
229
  sta_pred=lookup(tmax_predicted,data_v$lat,data_v$lon)
230
  #sta_pred=lookup(tmax_predicted,daily_sta_lola$lat,daily_sta_lola$lon)
231
  #rmse=RMSE(sta_pred,dmoday$dailyTmax)
232
  #pos<-match("value",names(data_v)) #Find column with name "value"
233
  #names(data_v)[pos]<-c("dailyTmax")
234
  tmax<-data_v$dailyTmax
235
  #data_v$dailyTmax<-tmax
236
  rmse=RMSE(sta_pred,tmax)
237
  mae<-MAE_fun(sta_pred,tmax)
238
  r2<-cor(sta_pred,tmax)^2              #R2, coef. of var
239
  me<-mean(sta_pred-tmax)
240
 
241
  #plot(sta_pred~dmoday$dailyTmax,xlab=paste("Actual daily for",datelabel),ylab="Pred daily",main=paste("RMSE=",rmse))
242
  
243
  png(paste("Predicted_tmax_versus_observed_scatterplot_",sampling_dat$date[i],"_",sampling_dat$prop[i],
244
            "_",sampling_dat$run_samp[i],out_prefix,".png", sep=""))
245
  plot(sta_pred~tmax,xlab=paste("Actual daily for",datelabel),ylab="Pred daily",main=paste("RMSE=",rmse))
246
  abline(0,1)
247
  #savePlot(paste("Predicted_tmax_versus_observed_scatterplot_",sampling_dat$date[i],out_prefix,".png", sep=""), type="png")
248
  dev.off()
249
  #resid=sta_pred-dmoday$dailyTmax
250
  resid=sta_pred-tmax
251
  #quilt.plot(daily_sta_lola,resid)
252
  
253
  ### END OF BRIAN's code
254
  
255
  ### Added by benoit
256
  
257
  ###BEFORE GAM prediction the data object must be transformed to SDF
258
  
259
  coords<- data_v[,c('x_OR83M','y_OR83M')]
260
  coordinates(data_v)<-coords
261
  proj4string(data_v)<-CRS  #Need to assign coordinates...
262
  coords<- data_s[,c('x_OR83M','y_OR83M')]
263
  coordinates(data_s)<-coords
264
  proj4string(data_s)<-CRS  #Need to assign coordinates..
265
  
266
  ns<-nrow(data_s) #This is added to because some loss of data might have happened because of the averaging...
267
  nv<-nrow(data_v)
268
  
269
  ###GAM PREDICTION
270
  
271
  #data_s$y_var<-data_s$dailyTmax  #This shoudl be changed for any variable!!!
272
  #data_v$y_var<-data_v$dailyTmax
273
  data_v$y_var<-data_v[[y_var_name]]
274
  data_s$y_var<-data_s[[y_var_name]]
275
  
276
  #Model and response variable can be changed without affecting the script
277
  
278
  formula1 <- as.formula("y_var ~ s(lat) + s(lon) + s(ELEV_SRTM)", env=.GlobalEnv)
279
  formula2 <- as.formula("y_var~ s(lat,lon)+ s(ELEV_SRTM)", env=.GlobalEnv)
280
  formula3 <- as.formula("y_var~ s(lat) + s (lon) + s (ELEV_SRTM) +  s (Northness)+ s (Eastness) + s(DISTOC)", env=.GlobalEnv)
281
  formula4 <- as.formula("y_var~ s(lat) + s (lon) + s(ELEV_SRTM) + s(Northness) + s (Eastness) + s(DISTOC) + s(LST)", env=.GlobalEnv)
282
  formula5 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)", env=.GlobalEnv)
283
  formula6 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC1)", env=.GlobalEnv)
284
  formula7 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC3)", env=.GlobalEnv)
285
  formula8 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST) + s(LST,LC1)", env=.GlobalEnv)
286
  
287
  #formula1 <- as.formula("y_var ~ s(lat,lon,ELEV_SRTM)", env=.GlobalEnv)
288
  #formula2 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM)  + s(Northness,Eastness) + s(DISTOC) + s(LST) + s(CANHEIGHT)", env=.GlobalEnv)
289
  #formula3 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST,CANHEIGHT)", env=.GlobalEnv)
290
  #formula4 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST,LC1)", env=.GlobalEnv)
291
  #formula5 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST,LC3)", env=.GlobalEnv)
292
  #formula6 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC1)", env=.GlobalEnv)
293
  #formula7 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC3)", env=.GlobalEnv)
294
  #formula8 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST,LC1) + s(LST,LC3)", env=.GlobalEnv)
295
  
296
  mod1<- try(gam(formula1, data=data_s))
297
  mod2<- try(gam(formula2, data=data_s)) #modified nesting....from 3 to 2
298
  mod3<- try(gam(formula3, data=data_s))
299
  mod4<- try(gam(formula4, data=data_s))
300
  mod5<- try(gam(formula5, data=data_s))
301
  mod6<- try(gam(formula6, data=data_s))
302
  mod7<- try(gam(formula7, data=data_s))
303
  mod8<- try(gam(formula8, data=data_s))
304
  
305
#   mod1<- try(gam(formula1, data=data_s))
306
#   mod2<- try(gam(formula2, data=data_s)) #modified nesting....from 3 to 2
307
#   mod3<- try(gam(y_var~ s(lat) + s (lon) + s (ELEV_SRTM) +  s (Northness)+ s (Eastness) + s(DISTOC), data=data_s))
308
#   mod4<- try(gam(y_var~ s(lat) + s (lon) + s(ELEV_SRTM) + s(Northness) + s (Eastness) + s(DISTOC) + s(LST), data=data_s))
309
#   mod5<- try(gam(y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST), data=data_s))
310
#   mod6<- try(gam(y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC1), data=data_s))
311
#   mod7<- try(gam(y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC3), data=data_s))
312
#   mod8<- try(gam(y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST) + s(LC1,LC3), data=data_s))
313
#   
314
  #Added
315
  #tmax_predicted=themolst+daily_delta_rast-bias_rast #Final surface?? but daily_rst
316
  
317
  ### Added by benoit
318
  #Store results using TPS
319
  j=nmodels+1
320
  results_RMSE[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
321
  results_RMSE[2]<- ns          #number of stations used in the training stage
322
  results_RMSE[3]<- "RMSE"
323

  
324
  results_RMSE[j+3]<- rmse  #Storing RMSE for the model j
325
  
326
  results_RMSE_f[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
327
  results_RMSE_f[2]<- ns          #number of stations used in the training stage
328
  results_RMSE_f[3]<- "RMSE_f"
329
  results_RMSE_f[j+3]<- rmse_fit  #Storing RMSE for the model j
330
  
331
  results_MAE_f[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
332
  results_MAE_f[2]<- ns          #number of stations used in the training stage
333
  results_MAE_f[3]<- "RMSE_f"
334
  results_MAE_f[j+3]<- mae_fit  #Storing RMSE for the model j
335

  
336
  results_MAE[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
337
  results_MAE[2]<- ns          #number of stations used in the training stage
338
  results_MAE[3]<- "MAE"
339
  results_MAE[j+3]<- mae  #Storing RMSE for the model j
340

  
341
  results_ME[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
342
  results_ME[2]<- ns          #number of stations used in the training stage
343
  results_ME[3]<- "ME"
344
  results_ME[j+3]<- me  #Storing RMSE for the model j
345
  
346
  results_R2[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
347
  results_R2[2]<- ns          #number of stations used in the training stage
348
  results_R2[3]<- "R2"
349
  results_R2[j+3]<- r2  #Storing RMSE for the model j
350
  
351
  #ns<-nrow(data_s) #This is added to because some loss of data might have happened because of the averaging...
352
  #nv<-nrow(data_v)
353
  
354
  
355
  for (j in 1:nmodels){
356
    
357
    ##Model assessment: specific diagnostic/metrics for GAM
358
    
359
    name<-paste("mod",j,sep="")  #modj is the name of The "j" model (mod1 if j=1) 
360
    mod<-get(name)               #accessing GAM model ojbect "j"
361
    
362
    #If mod "j" is not a model object
363
    if (inherits(mod,"try-error")) {
364
      results_AIC[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
365
      results_AIC[2]<- ns        #number of stations used in the training stage
366
      results_AIC[3]<- "AIC"
367
      results_AIC[j+3]<- NA
368
      
369
      results_GCV[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
370
      results_GCV[2]<- ns        #number of stations used in the training 
371
      results_GCV[3]<- "GCV"
372
      results_GCV[j+3]<- NA
373
      
374
      results_DEV[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
375
      results_DEV[2]<- ns        #number of stations used in the training stage
376
      results_DEV[3]<- "DEV"
377
      results_DEV[j+3]<- NA
378
      
379
      results_RMSE_f[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
380
      results_RMSE_f[2]<- ns        #number of stations used in the training stage
381
      results_RMSE_f[3]<- "RSME_f"
382
      results_RMSE_f[j+3]<- NA
383
      
384
      results_MAE_f[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
385
      results_MAE_f[2]<- ns        #number of stations used in the training stage
386
      results_MAE_f[3]<- "MAE_f"
387
      results_MAE_f[j+3]<-NA
388
      
389
      results_RMSE[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
390
      results_RMSE[2]<- ns          #number of stations used in the training stage
391
      results_RMSE[3]<- "RMSE"
392
      results_RMSE[j+3]<- NA  #Storing RMSE for the model j
393
      results_MAE[1]<- sampling_dat$date[i]     #storing the interpolation dates in the first column
394
      results_MAE[2]<- ns           #number of stations used in the training stage
395
      results_MAE[3]<- "MAE"
396
      results_MAE[j+3]<- NA    #Storing MAE for the model j
397
      results_ME[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
398
      results_ME[2]<- ns            #number of stations used in the training stage
399
      results_ME[3]<- "ME"
400
      results_ME[j+3]<- NA      #Storing ME for the model j
401
      results_R2[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
402
      results_R2[2]<- ns            #number of stations used in the training stage
403
      results_R2[3]<- "R2"
404
      
405
      
406
      results_R2[j+3]<- NA      #Storing R2 for the model j
407
      
408
    }
409
    
410
    #If mod is a modelobject
411
    
412
    #If mod "j" is not a model object
413
    if (inherits(mod,"gam")) {
414
      
415
      results_AIC[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
416
      results_AIC[2]<- ns        #number of stations used in the training stage
417
      results_AIC[3]<- "AIC"
418
      results_AIC[j+3]<- AIC (mod)
419
      
420
      results_GCV[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
421
      results_GCV[2]<- ns        #number of stations used in the training 
422
      results_GCV[3]<- "GCV"
423
      results_GCV[j+3]<- mod$gcv.ubre
424
      
425
      results_DEV[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
426
      results_DEV[2]<- ns        #number of stations used in the training stage
427
      results_DEV[3]<- "DEV"
428
      results_DEV[j+3]<- mod$deviance
429
      
430
      y_var_fit= mod$fit
431
    
432
      results_RMSE_f[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
433
      results_RMSE_f[2]<- ns        #number of stations used in the training stage
434
      results_RMSE_f[3]<- "RSME_f"
435
      #results_RMSE_f[j+3]<- sqrt(sum((y_var_fit-data_s$y_var)^2)/ns)
436
      results_RMSE_f[j+3]<-sqrt(mean(mod$residuals^2,na.rm=TRUE))
437
      
438
      results_MAE_f[1]<- sampling_dat$date[i]  #storing the interpolation sampling_dat$date in the first column
439
      results_MAE_f[2]<- ns        #number of stations used in the training stage
440
      results_MAE_f[3]<- "MAE_f"
441
      #results_MAE_f[j+3]<-sum(abs(y_var_fit-data_s$y_var))/ns
442
      results_MAE_f[j+3]<-mean(abs(mod$residuals),na.rm=TRUE)
443
      
444
      ##Model assessment: general diagnostic/metrics
445
      ##validation: using the testing data
446
      if (predval==1) {
447
      
448
        ##Model assessment: specific diagnostic/metrics for GAM
449
        
450
        name<-paste("mod",j,sep="")  #modj is the name of The "j" model (mod1 if j=1) 
451
        mod<-get(name)               #accessing GAM model ojbect "j"
452
        
453
        s_sgdf<-as(s_raster,"SpatialGridDataFrame") #Conversion to spatial grid data frame
454
        
455
        rpred<- predict(mod, newdata=s_sgdf, se.fit = TRUE) #Using the coeff to predict new values.
456
        y_pred<-rpred$fit
457
        raster_pred<-r1
458
        layerNames(raster_pred)<-"y_pred"
459
        values(raster_pred)<-as.numeric(y_pred)
460
        data_name<-paste("predicted_mod",j,"_",sampling_dat$date[i],"_",sampling_dat$prop[i],
461
                         "_",sampling_dat$run_samp[i],sep="")
462
        raster_name<-paste("GAM_",data_name,out_prefix,".rst", sep="")
463
        writeRaster(raster_pred, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
464
        #writeRaster(r2, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
465
        
466
        pred_sgdf<-as(raster_pred,"SpatialGridDataFrame") #Conversion to spatial grid data frame
467
        #rpred_val_s <- overlay(raster_pred,data_s)             #This overlays the kriged surface tmax and the location of weather stations
468
        
469
        rpred_val_s <- overlay(pred_sgdf,data_s)             #This overlays the kriged surface tmax and the location of weather stations
470
        rpred_val_v <- overlay(pred_sgdf,data_v)             #This overlays the kriged surface tmax and the location of weather stations
471
        
472
        pred_mod<-paste("pred_mod",j,sep="")
473
        #Adding the results back into the original dataframes.
474
        data_s[[pred_mod]]<-rpred_val_s$y_pred
475
        
476
        data_v[[pred_mod]]<-rpred_val_v$y_pred  
477
        
478
        #Model assessment: RMSE and then krig the residuals....!
479
        
480
        res_mod_s<- data_s$y_var - data_s[[pred_mod]]           #Residuals from kriging training
481
        res_mod_v<- data_v$y_var - data_v[[pred_mod]]           #Residuals from kriging validation
482
        
483
      }
484
      
485
      if (predval==0) {
486
      
487
        y_mod<- predict(mod, newdata=data_v, se.fit = TRUE) #Using the coeff to predict new values.
488
        
489
        pred_mod<-paste("pred_mod",j,sep="")
490
        #Adding the results back into the original dataframes.
491
        data_s[[pred_mod]]<-as.numeric(mod$fit)
492
        data_v[[pred_mod]]<-as.numeric(y_mod$fit)
493
        
494
        #Model assessment: RMSE and then krig the residuals....!
495
        
496
        res_mod_s<- data_s$y_var - data_s[[pred_mod]]           #Residuals from kriging training
497
        res_mod_v<- data_v$y_var - data_v[[pred_mod]]           #Residuals from kriging validation
498
      }
499

  
500
      ####ADDED ON JULY 20th
501
      res_mod<-res_mod_v
502
      
503
      #RMSE_mod <- sqrt(sum(res_mod^2)/nv)                 #RMSE FOR REGRESSION STEP 1: GAM  
504
      RMSE_mod<- sqrt(mean(res_mod^2,na.rm=TRUE))
505
      #MAE_mod<- sum(abs(res_mod),na.rm=TRUE)/(nv-sum(is.na(res_mod)))        #MAE from kriged surface validation
506
      MAE_mod<- mean(abs(res_mod), na.rm=TRUE)
507
      #ME_mod<- sum(res_mod,na.rm=TRUE)/(nv-sum(is.na(res_mod)))                    #ME, Mean Error or bias FOR REGRESSION STEP 1: GAM
508
      ME_mod<- mean(res_mod,na.rm=TRUE)                            #ME, Mean Error or bias FOR REGRESSION STEP 1: GAM
509
      #R2_mod<- cor(data_v$y_var,data_v[[pred_mod]])^2              #R2, coef. of var FOR REGRESSION STEP 1: GAM
510
      R2_mod<- cor(data_v$y_var,data_v[[pred_mod]], use="complete")^2
511
      results_RMSE[1]<- sampling_dat$date[i]    #storing the interpolation sampling_dat$date in the first column
512
      results_RMSE[2]<- ns          #number of stations used in the training stage
513
      results_RMSE[3]<- "RMSE"
514
      results_RMSE[j+3]<- RMSE_mod  #Storing RMSE for the model j
515
      results_MAE[1]<- sampling_dat$date[i]     #storing the interpolation dates in the first column
516
      results_MAE[2]<- ns           #number of stations used in the training stage
517
      results_MAE[3]<- "MAE"
518
      results_MAE[j+3]<- MAE_mod    #Storing MAE for the model j
519
      results_ME[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
520
      results_ME[2]<- ns            #number of stations used in the training stage
521
      results_ME[3]<- "ME"
522
      results_ME[j+3]<- ME_mod      #Storing ME for the model j
523
      results_R2[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
524
      results_R2[2]<- ns            #number of stations used in the training stage
525
      results_R2[3]<- "R2"
526
      results_R2[j+3]<- R2_mod      #Storing R2 for the model j
527
      
528
      #Saving residuals and prediction in the dataframes: tmax predicted from GAM
529

  
530
      name2<-paste("res_mod",j,sep="")
531
      data_v[[name2]]<-as.numeric(res_mod_v)
532
      data_s[[name2]]<-as.numeric(res_mod_s)
533
      #end of loop calculating RMSE
534
    }
535
  }
536
  
537
  #if (i==length(dates)){
538
  
539
  #Specific diagnostic measures related to the testing datasets
540

  
541
  results_table_RMSE<-as.data.frame(results_RMSE)
542
  results_table_MAE<-as.data.frame(results_MAE)
543
  results_table_ME<-as.data.frame(results_ME)
544
  results_table_R2<-as.data.frame(results_R2)
545
  results_table_RMSE_f<-as.data.frame(results_RMSE_f)
546
  results_table_MAE_f<-as.data.frame(results_MAE_f)
547
  
548
  results_table_AIC<-as.data.frame(results_AIC)
549
  results_table_GCV<-as.data.frame(results_GCV)
550
  results_table_DEV<-as.data.frame(results_DEV)
551
  
552
  tb_metrics1<-rbind(results_table_RMSE,results_table_MAE, results_table_ME, results_table_R2,results_table_RMSE_f,results_table_MAE_f)   #
553
  tb_metrics2<-rbind(results_table_AIC,results_table_GCV, results_table_DEV)
554
  cname<-c("dates","ns","metric","mod1", "mod2","mod3", "mod4", "mod5", "mod6", "mod7","mod8","mod9")
555
  colnames(tb_metrics1)<-cname
556
  cname<-c("dates","ns","metric","mod1", "mod2","mod3", "mod4", "mod5", "mod6", "mod7","mod8")
557
  colnames(tb_metrics2)<-cname
558
  #colnames(results_table_RMSE)<-cname
559
  #colnames(results_table_RMSE_f)<-cname
560
  #tb_diagnostic1<-results_table_RMSE      #measures of validation
561
  #tb_diagnostic2<-results_table_RMSE_f    #measures of fit
562
  
563
  #write.table(tb_diagnostic1, file= paste(path,"/","results_fusion_Assessment_measure1",out_prefix,".txt",sep=""), sep=",")
564
  
565
  #}  
566
  print(paste(sampling_dat$date[i],"processed"))
567
  # end of the for loop1
568
  mod_obj<-list(mod1,mod2,mod3,mod4,mod5,mod6,mod7,mod8,mod9a,mod9b)
569
  names(mod_obj)<-c("mod1","mod2","mod3","mod4","mod5","mod6","mod7","mod8","mod9a","mod9b")
570
  #results_list<-list(data_s,data_v,tb_metrics1,tb_metrics2)
571
  results_list<-list(data_s,data_v,tb_metrics1,tb_metrics2,mod_obj)
572
  names(results_list)<-c("data_s","data_v","tb_metrics1","tb_metrics2","mod_obj")
573
  save(results_list,file= paste(path,"/","results_list_metrics_objects_",sampling_dat$date[i],"_",sampling_dat$prop[i],
574
                                "_",sampling_dat$run_samp[i],out_prefix,".RData",sep=""))
575
  return(results_list)
576
  #return(tb_diagnostic1)
577
}

Also available in: Unified diff