Project

General

Profile

Download (27.7 KB) Statistics
| Branch: | Revision:
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",layerNames(s_raster)) #Find column with name "LST"
12
  s_raster<-dropLayer(s_raster,pos) # If it exists drop layer
13
  pos<-match(LST_month,layerNames(s_raster)) #Find column with the current month for instance mm12
14
  r1<-raster(s_raster,layer=pos)             #Select layer from stack
15
  layerNames(r1)<-"LST"
16
  s_raster<-addLayer(s_raster,r1)            #Adding current month as "LST"
17
  
18
  ###Regression part 1: Creating a validation dataset by creating training and testing datasets
19
  
20
  mod_LST <-ghcn.subsets[[i]][,match(LST_month, names(ghcn.subsets[[i]]))]  #Match interpolation date and monthly LST average
21
  ghcn.subsets[[i]] = transform(ghcn.subsets[[i]],LST = mod_LST)            #Add the variable LST to the subset dataset
22
  dst$LST<-dst[[LST_month]]
23
  #n<-nrow(ghcn.subsets[[i]])
24
  #ns<-n-round(n*prop)   #Create a sample from the data frame with 70% of the rows
25
  #nv<-n-ns              #create a sample for validation with prop of the rows
26
  #ind.training <- sample(nrow(ghcn.subsets[[i]]), size=ns, replace=FALSE) #This selects the index position for 70% of the rows taken randomly
27
  ind.training<-sampling[[i]]
28
  ind.testing <- setdiff(1:nrow(ghcn.subsets[[i]]), ind.training)
29
  data_s <- ghcn.subsets[[i]][ind.training, ]   #Training dataset currently used in the modeling
30
  data_v <- ghcn.subsets[[i]][ind.testing, ]    #Testing/validation dataset using input sampling
31
  
32
  ns<-nrow(data_s)
33
  nv<-nrow(data_v)
34
  #i=1
35
  date_proc<-sampling_dat$date[i]
36
  date_proc<-strptime(sampling_dat$date[i], "%Y%m%d")   # interpolation date being processed
37
  mo<-as.integer(strftime(date_proc, "%m"))          # current month of the date being processed
38
  day<-as.integer(strftime(date_proc, "%d"))
39
  year<-as.integer(strftime(date_proc, "%Y"))
40

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

    
47
  themolst<-raster(molst,mo) #current month being processed saved in a raster image
48
  plot(themolst)
49
  
50
  ###########
51
  # STEP 2 - Weather station means across same days: Monthly mean calculation
52
  ###########
53
  
54
  modst<-dst[dst$month==mo,] #Subsetting dataset for the relevant month of the date being processed
55
  
56
  ##########
57
  # STEP 3 - get LST at stations  
58
  ##########
59
  
60
  sta_lola=modst[,c("lon","lat")] #Extracting locations of stations for the current month..
61
  
62
  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";
63
  lookup<-function(r,lat,lon) {
64
    xy<-project(cbind(lon,lat),proj_str);
65
    cidx<-cellFromXY(r,xy);
66
    return(r[cidx])
67
  }
68
  sta_tmax_from_lst=lookup(themolst,sta_lola$lat,sta_lola$lon) #Extracted values of LST for the stations
69
  
70
  #########
71
  # STEP 4 - bias at stations     
72
  #########
73
  
74
  sta_bias=sta_tmax_from_lst-modst$TMax; #That is the difference between the monthly LST mean and monthly station mean
75
  #Added by Benoit
76
  modst$LSTD_bias<-sta_bias  #Adding bias to data frame modst containning the monthly average for 10 years
77
  
78
  bias_xy=project(as.matrix(sta_lola),proj_str)
79
  png(paste("LST_TMax_scatterplot_",sampling_dat$date[i],"_",sampling_dat$prop[i],"_",sampling_dat$run_samp[i], out_prefix,".png", sep=""))
80
  plot(modst$TMax,sta_tmax_from_lst,xlab="Station mo Tmax",ylab="LST mo Tmax",main=paste("LST vs TMax for",datelabel,sep=" "))
81
  abline(0,1)
82
  dev.off()
83
  
84
  #added by Benoit 
85
  #x<-ghcn.subsets[[i]]  #Holds both training and testing for instance 161 rows for Jan 1
86
  x<-data_v
87
  d<-data_s
88
  
89
  pos<-match("value",names(d)) #Find column with name "value"
90
  #names(d)[pos]<-c("dailyTmax")
91
  names(d)[pos]<-y_var_name
92
  names(x)[pos]<-y_var_name
93
  #names(x)[pos]<-c("dailyTmax")
94
  d$dailyTmax=(as.numeric(d$dailyTmax))/10 #stored as 1/10 degree C to allow integer storage
95
  x$dailyTmax=(as.numeric(x$dailyTmax))/10 #stored as 1/10 degree C to allow integer storage
96
  pos<-match("station",names(d)) #Find column with name "value"
97
  names(d)[pos]<-c("id")
98
  names(x)[pos]<-c("id")
99
  names(modst)[1]<-c("id")       #modst contains the average tmax per month for every stations...
100
  
101
  dmoday=merge(modst,d,by="id",suffixes=c("",".y2"))  #LOOSING DATA HERE!!! from 113 t0 103
102
  xmoday=merge(modst,x,by="id",suffixes=c("",".y2"))  #LOOSING DATA HERE!!! from 48 t0 43
103
  mod_pat<-glob2rx("*.y2")   
104
  var_pat<-grep(mod_pat,names(dmoday),value=FALSE) # using grep with "value" extracts the matching names
105
  dmoday<-dmoday[,-var_pat]
106
  mod_pat<-glob2rx("*.y2")   
107
  var_pat<-grep(mod_pat,names(xmoday),value=FALSE) # using grep with "value" extracts the matching names
108
  xmoday<-xmoday[,-var_pat] #Removing duplicate columns
109
  
110
  data_v<-xmoday
111
  ###
112
  
113
  #dmoday contains the daily tmax values for training with TMax being the monthly station tmax mean
114
  #xmoday contains the daily tmax values for validation with TMax being the monthly station tmax mean
115
  
116
  png(paste("Daily_tmax_monthly_TMax_scatterplot_",sampling_dat$date[i],"_",sampling_dat$prop[i],
117
            "_",sampling_dat$run_samp[i],out_prefix,".png", sep=""))
118
  plot(dailyTmax~TMax,data=dmoday,xlab="Mo Tmax",ylab=paste("Daily for",datelabel),main="across stations in OR")
119
  dev.off()
120
  
121
  ########
122
  # STEP 5 - interpolate bias
123
  ########
124
  
125
  # ?? include covariates like elev, distance to coast, cloud frequency, tree heig
126
  #fitbias<-Tps(bias_xy,sta_bias) #use TPS or krige
127
  
128
  #Adding options to use only training stations : 07/11/2012
129
  bias_xy=project(as.matrix(sta_lola),proj_str)
130
  #bias_xy2=project(as.matrix(c(dmoday$lon,dmoday$lat),proj_str)
131
  if(bias_val==1){
132
    sta_bias<-dmoday$LSTD_bias
133
    bias_xy<-cbind(dmoday$x_OR83M,dmoday$y_OR83M)
134
  }
135
  
136
  fitbias<-Krig(bias_xy,sta_bias,theta=1e5) #use TPS or krige 
137
  #The output is a krig object using fields
138
  mod9a<-fitbias
139
    
140
  ##########
141
  # STEP 7 - interpolate delta across space
142
  ##########
143
  
144
  daily_sta_lola=dmoday[,c("lon","lat")] #could be same as before but why assume merge does this - assume not
145
  daily_sta_xy=project(as.matrix(daily_sta_lola),proj_str)
146
  daily_delta=dmoday$dailyTmax-dmoday$TMax
147
  
148
  #fitdelta<-Tps(daily_sta_xy,daily_delta) #use TPS or krige
149
  fitdelta<-Krig(daily_sta_xy,daily_delta,theta=1e5) #use TPS or krige
150
  #Kriging using fields package
151
  mod9b<-fitdelta
152

    
153
  png(paste("Delta_surface_LST_TMax_",sampling_dat$date[i],"_",sampling_dat$prop[i],
154
            "_",sampling_dat$run_samp[i],out_prefix,".png", sep=""))
155
  surface(fitdelta,col=rev(terrain.colors(100)),asp=1,main=paste("Interpolated delta for",datelabel,sep=" "))
156
  dev.off()
157
  #
158
  
159
  #### Added by Benoit on 06/19
160
  data_s<-dmoday #put the 
161
  data_s$daily_delta<-daily_delta
162
  
163
  #data_s$y_var<-daily_delta  #y_var is the variable currently being modeled, may be better with BIAS!!
164
  #data_s$y_var<-data_s$LSTD_bias
165
  #### Added by Benoit ends
166
  
167
  #########
168
  # STEP 8 - assemble final answer - T=LST+Bias(interpolated)+delta(interpolated)
169
  #########
170

    
171
  bias_rast=interpolate(themolst,fitbias) #interpolation using function from raster package
172
  #themolst is raster layer, fitbias is "Krig" object from bias surface
173
  #plot(bias_rast,main="Raster bias") #This not displaying...
174
  
175
  #Saving kriged surface in raster images
176
  data_name<-paste("bias_LST_",sampling_dat$date[i],"_",sampling_dat$prop[i],
177
                   "_",sampling_dat$run_samp[i],sep="")
178
  raster_name<-paste("fusion_",data_name,out_prefix,".rst", sep="")
179
  writeRaster(bias_rast, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
180
  
181
  daily_delta_rast=interpolate(themolst,fitdelta) #Interpolation of the bias surface...
182
  
183
  #plot(daily_delta_rast,main="Raster Daily Delta")
184
  
185
  #Saving kriged surface in raster images
186
  data_name<-paste("daily_delta_",sampling_dat$date[i],"_",sampling_dat$prop[i],
187
                   "_",sampling_dat$run_samp[i],sep="")
188
  raster_name<-paste("fusion_",data_name,out_prefix,".rst", sep="")
189
  writeRaster(daily_delta_rast, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
190
  
191
  tmax_predicted=themolst+daily_delta_rast-bias_rast #Final surface  as a raster layer...
192
  #tmax_predicted=themolst+daily_delta_rast+bias_rast #Added by Benoit, why is it -bias_rast
193
  #plot(tmax_predicted,main="Predicted daily")
194
  
195
  #Saving kriged surface in raster images
196
  data_name<-paste("tmax_predicted_",sampling_dat$date[i],"_",sampling_dat$prop[i],
197
                   "_",sampling_dat$run_samp[i],sep="")
198
  raster_name<-paste("fusion_",data_name,out_prefix,".rst", sep="")
199
  writeRaster(tmax_predicted, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
200
  
201
  ########
202
  # check: assessment of results: validation
203
  ########
204
  RMSE<-function(x,y) {return(mean((x-y)^2)^0.5)}
205
  MAE_fun<-function(x,y) {return(mean(abs(x-y)))}
206
  #ME_fun<-function(x,y){return(mean(abs(y)))}
207
  #FIT ASSESSMENT
208
  sta_pred_data_s=lookup(tmax_predicted,data_s$lat,data_s$lon)
209
  rmse_fit=RMSE(sta_pred_data_s,data_s$dailyTmax)
210
  mae_fit=MAE_fun(sta_pred_data_s,data_s$dailyTmax)
211
    
212
  sta_pred=lookup(tmax_predicted,data_v$lat,data_v$lon)
213
  #sta_pred=lookup(tmax_predicted,daily_sta_lola$lat,daily_sta_lola$lon)
214
  #rmse=RMSE(sta_pred,dmoday$dailyTmax)
215
  #pos<-match("value",names(data_v)) #Find column with name "value"
216
  #names(data_v)[pos]<-c("dailyTmax")
217
  tmax<-data_v$dailyTmax
218
  #data_v$dailyTmax<-tmax
219
  rmse=RMSE(sta_pred,tmax)
220
  mae<-MAE_fun(sta_pred,tmax)
221
  r2<-cor(sta_pred,tmax)^2              #R2, coef. of var
222
  me<-mean(sta_pred-tmax)
223
   
224
  png(paste("Predicted_tmax_versus_observed_scatterplot_",sampling_dat$date[i],"_",sampling_dat$prop[i],
225
            "_",sampling_dat$run_samp[i],out_prefix,".png", sep=""))
226
  plot(sta_pred~tmax,xlab=paste("Actual daily for",datelabel),ylab="Pred daily",main=paste("RMSE=",rmse))
227
  abline(0,1)
228
  dev.off()
229
  #resid=sta_pred-dmoday$dailyTmax
230
  resid=sta_pred-tmax
231
  
232
  ###BEFORE GAM prediction the data object must be transformed to SDF
233
  
234
  coords<- data_v[,c('x_OR83M','y_OR83M')]
235
  coordinates(data_v)<-coords
236
  proj4string(data_v)<-CRS  #Need to assign coordinates...
237
  coords<- data_s[,c('x_OR83M','y_OR83M')]
238
  coordinates(data_s)<-coords
239
  proj4string(data_s)<-CRS  #Need to assign coordinates..
240
  coords<- modst[,c('x_OR83M','y_OR83M')]
241
  coordinates(modst)<-coords
242
  proj4string(modst)<-CRS  #Need to assign coordinates..
243
  
244
  ns<-nrow(data_s) #This is added to because some loss of data might have happened because of the averaging...
245
  nv<-nrow(data_v)
246
  
247
  ###GAM PREDICTION
248
  
249
  if (bias_prediction==1){
250
    data_s$y_var<-data_s$LSTD_bias  #This shoudl be changed for any variable!!!
251
    data_v$y_var<-data_v$LSTD_bias
252
    data_month<-modst
253
    data_month$y_var<-modst$LSTD_bias
254
  }
255

    
256
  if (bias_prediction==0){
257
    data_v$y_var<-data_v[[y_var_name]]
258
    data_s$y_var<-data_s[[y_var_name]]
259
  }
260
  
261
  #Model and response variable can be changed without affecting the script
262
  
263
  formula1 <- as.formula("y_var ~ s(lat) + s(lon) + s(ELEV_SRTM)", env=.GlobalEnv)
264
  formula2 <- as.formula("y_var~ s(lat,lon)+ s(ELEV_SRTM)", env=.GlobalEnv)
265
  formula3 <- as.formula("y_var~ s(lat) + s (lon) + s (ELEV_SRTM) +  s (Northness)+ s (Eastness) + s(DISTOC)", env=.GlobalEnv)
266
  formula4 <- as.formula("y_var~ s(lat) + s (lon) + s(ELEV_SRTM) + s(Northness) + s (Eastness) + s(DISTOC) + s(LST)", env=.GlobalEnv)
267
  formula5 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)", env=.GlobalEnv)
268
  formula6 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC1)", env=.GlobalEnv)
269
  formula7 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC3)", env=.GlobalEnv)
270
  formula8 <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST) + s(LC1,LC3)", env=.GlobalEnv)
271
  
272
  if (bias_prediction==1){
273
    mod1<- try(gam(formula1, data=data_month))
274
    mod2<- try(gam(formula2, data=data_month)) #modified nesting....from 3 to 2
275
    mod3<- try(gam(formula3, data=data_month))
276
    mod4<- try(gam(formula4, data=data_month))
277
    mod5<- try(gam(formula5, data=data_month))
278
    mod6<- try(gam(formula6, data=data_month))
279
    mod7<- try(gam(formula7, data=data_month))
280
    mod8<- try(gam(formula8, data=data_month)) 
281
    
282
  } else if (bias_prediction==0){
283
    
284
    mod1<- try(gam(formula1, data=data_s))
285
    mod2<- try(gam(formula2, data=data_s)) #modified nesting....from 3 to 2
286
    mod3<- try(gam(formula3, data=data_s))
287
    mod4<- try(gam(formula4, data=data_s))
288
    mod5<- try(gam(formula5, data=data_s))
289
    mod6<- try(gam(formula6, data=data_s))
290
    mod7<- try(gam(formula7, data=data_s))
291
    mod8<- try(gam(formula8, data=data_s))
292
  }
293

    
294
  #Added
295
  #tmax_predicted=themolst+daily_delta_rast-bias_rast #Final surface?? but daily_rst
296
  
297
  ### Added by benoit
298
  #Store results using TPS
299
  j=nmodels+1
300
  results_RMSE[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
301
  results_RMSE[2]<- ns          #number of stations used in the training stage
302
  results_RMSE[3]<- "RMSE"
303

    
304
  results_RMSE[j+3]<- rmse  #Storing RMSE for the model j
305
  
306
  results_RMSE_f[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
307
  results_RMSE_f[2]<- ns          #number of stations used in the training stage
308
  results_RMSE_f[3]<- "RMSE_f"
309
  results_RMSE_f[j+3]<- rmse_fit  #Storing RMSE for the model j
310
  
311
  results_MAE_f[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
312
  results_MAE_f[2]<- ns          #number of stations used in the training stage
313
  results_MAE_f[3]<- "RMSE_f"
314
  results_MAE_f[j+3]<- mae_fit  #Storing RMSE for the model j
315

    
316
  results_MAE[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
317
  results_MAE[2]<- ns          #number of stations used in the training stage
318
  results_MAE[3]<- "MAE"
319
  results_MAE[j+3]<- mae  #Storing RMSE for the model j
320

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

    
520
      ####ADDED ON JULY 20th
521
      res_mod<-res_mod_v
522
      
523
      #RMSE_mod <- sqrt(sum(res_mod^2)/nv)                 #RMSE FOR REGRESSION STEP 1: GAM  
524
      RMSE_mod<- sqrt(mean(res_mod^2,na.rm=TRUE))
525
      #MAE_mod<- sum(abs(res_mod),na.rm=TRUE)/(nv-sum(is.na(res_mod)))        #MAE from kriged surface validation
526
      MAE_mod<- mean(abs(res_mod), na.rm=TRUE)
527
      #ME_mod<- sum(res_mod,na.rm=TRUE)/(nv-sum(is.na(res_mod)))                    #ME, Mean Error or bias FOR REGRESSION STEP 1: GAM
528
      ME_mod<- mean(res_mod,na.rm=TRUE)                            #ME, Mean Error or bias FOR REGRESSION STEP 1: GAM
529
      #R2_mod<- cor(data_v$y_var,data_v[[pred_mod]])^2              #R2, coef. of var FOR REGRESSION STEP 1: GAM
530
      R2_mod<- cor(data_v$y_var,data_v[[pred_mod]], use="complete")^2
531
      results_RMSE[1]<- sampling_dat$date[i]    #storing the interpolation sampling_dat$date in the first column
532
      results_RMSE[2]<- ns          #number of stations used in the training stage
533
      results_RMSE[3]<- "RMSE"
534
      results_RMSE[j+3]<- RMSE_mod  #Storing RMSE for the model j
535
      results_MAE[1]<- sampling_dat$date[i]     #storing the interpolation dates in the first column
536
      results_MAE[2]<- ns           #number of stations used in the training stage
537
      results_MAE[3]<- "MAE"
538
      results_MAE[j+3]<- MAE_mod    #Storing MAE for the model j
539
      results_ME[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
540
      results_ME[2]<- ns            #number of stations used in the training stage
541
      results_ME[3]<- "ME"
542
      results_ME[j+3]<- ME_mod      #Storing ME for the model j
543
      results_R2[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
544
      results_R2[2]<- ns            #number of stations used in the training stage
545
      results_R2[3]<- "R2"
546
      results_R2[j+3]<- R2_mod      #Storing R2 for the model j
547
      
548
      #Saving residuals and prediction in the dataframes: tmax predicted from GAM
549

    
550
      name2<-paste("res_mod",j,sep="")
551
      data_v[[name2]]<-as.numeric(res_mod_v)
552
      data_s[[name2]]<-as.numeric(res_mod_s)
553
      #end of loop calculating RMSE
554
    }
555
  }
556
  
557
  #if (i==length(dates)){
558
  
559
  #Specific diagnostic measures related to the testing datasets
560

    
561
  results_table_RMSE<-as.data.frame(results_RMSE)
562
  results_table_MAE<-as.data.frame(results_MAE)
563
  results_table_ME<-as.data.frame(results_ME)
564
  results_table_R2<-as.data.frame(results_R2)
565
  results_table_RMSE_f<-as.data.frame(results_RMSE_f)
566
  results_table_MAE_f<-as.data.frame(results_MAE_f)
567
  
568
  results_table_AIC<-as.data.frame(results_AIC)
569
  results_table_GCV<-as.data.frame(results_GCV)
570
  results_table_DEV<-as.data.frame(results_DEV)
571
  
572
  tb_metrics1<-rbind(results_table_RMSE,results_table_MAE, results_table_ME, results_table_R2,results_table_RMSE_f,results_table_MAE_f)   #
573
  tb_metrics2<-rbind(results_table_AIC,results_table_GCV, results_table_DEV)
574
  cname<-c("dates","ns","metric","mod1", "mod2","mod3", "mod4", "mod5", "mod6", "mod7","mod8","mod9")
575
  colnames(tb_metrics1)<-cname
576
  cname<-c("dates","ns","metric","mod1", "mod2","mod3", "mod4", "mod5", "mod6", "mod7","mod8")
577
  colnames(tb_metrics2)<-cname
578
  #colnames(results_table_RMSE)<-cname
579
  #colnames(results_table_RMSE_f)<-cname
580
  #tb_diagnostic1<-results_table_RMSE      #measures of validation
581
  #tb_diagnostic2<-results_table_RMSE_f    #measures of fit
582
  
583
  #write.table(tb_diagnostic1, file= paste(path,"/","results_fusion_Assessment_measure1",out_prefix,".txt",sep=""), sep=",")
584
  
585
  #}  
586
  print(paste(sampling_dat$date[i],"processed"))
587
  # end of the for loop1
588
  mod_obj<-list(mod1,mod2,mod3,mod4,mod5,mod6,mod7,mod8,mod9a,mod9b)
589
  names(mod_obj)<-c("mod1","mod2","mod3","mod4","mod5","mod6","mod7","mod8","mod9a","mod9b")
590
  #results_list<-list(data_s,data_v,tb_metrics1,tb_metrics2)
591
  results_list<-list(data_s,data_v,tb_metrics1,tb_metrics2,mod_obj,sampling_dat[i,],data_month)
592
  names(results_list)<-c("data_s","data_v","tb_metrics1","tb_metrics2","mod_obj","sampling_dat","data_month")
593
  save(results_list,file= paste(path,"/","results_list_metrics_objects_",sampling_dat$date[i],"_",sampling_dat$prop[i],
594
                                "_",sampling_dat$run_samp[i],out_prefix,".RData",sep=""))
595
  return(results_list)
596
  #return(tb_diagnostic1)
597
}
(8-8/32)