Project

General

Profile

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

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

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

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

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

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

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

    
478
      ####ADDED ON JULY 20th
479
      res_mod<-res_mod_v
480
      
481
      #RMSE_mod <- sqrt(sum(res_mod^2)/nv)                 #RMSE FOR REGRESSION STEP 1: GAM  
482
      RMSE_mod<- sqrt(mean(res_mod^2,na.rm=TRUE))
483
      #MAE_mod<- sum(abs(res_mod),na.rm=TRUE)/(nv-sum(is.na(res_mod)))        #MAE from kriged surface validation
484
      MAE_mod<- mean(abs(res_mod), na.rm=TRUE)
485
      #ME_mod<- sum(res_mod,na.rm=TRUE)/(nv-sum(is.na(res_mod)))                    #ME, Mean Error or bias FOR REGRESSION STEP 1: GAM
486
      ME_mod<- mean(res_mod,na.rm=TRUE)                            #ME, Mean Error or bias FOR REGRESSION STEP 1: GAM
487
      #R2_mod<- cor(data_v$y_var,data_v[[pred_mod]])^2              #R2, coef. of var FOR REGRESSION STEP 1: GAM
488
      R2_mod<- cor(data_v$y_var,data_v[[pred_mod]], use="complete")^2
489
      results_RMSE[1]<- dates[i]    #storing the interpolation dates in the first column
490
      results_RMSE[2]<- ns          #number of stations used in the training stage
491
      results_RMSE[3]<- "RMSE"
492
      results_RMSE[j+3]<- RMSE_mod  #Storing RMSE for the model j
493
      results_MAE[1]<- dates[i]     #storing the interpolation dates in the first column
494
      results_MAE[2]<- ns           #number of stations used in the training stage
495
      results_MAE[3]<- "MAE"
496
      results_MAE[j+3]<- MAE_mod    #Storing MAE for the model j
497
      results_ME[1]<- dates[i]      #storing the interpolation dates in the first column
498
      results_ME[2]<- ns            #number of stations used in the training stage
499
      results_ME[3]<- "ME"
500
      results_ME[j+3]<- ME_mod      #Storing ME for the model j
501
      results_R2[1]<- dates[i]      #storing the interpolation dates in the first column
502
      results_R2[2]<- ns            #number of stations used in the training stage
503
      results_R2[3]<- "R2"
504
      results_R2[j+3]<- R2_mod      #Storing R2 for the model j
505
      
506
      #Saving residuals and prediction in the dataframes: tmax predicted from GAM
507

    
508
      name2<-paste("res_mod",j,sep="")
509
      data_v[[name2]]<-as.numeric(res_mod_v)
510
      data_s[[name2]]<-as.numeric(res_mod_s)
511
      #end of loop calculating RMSE
512
    }
513
  }
514
  
515
  #if (i==length(dates)){
516
  
517
  #Specific diagnostic measures related to the testing datasets
518

    
519
  results_table_RMSE<-as.data.frame(results_RMSE)
520
  results_table_MAE<-as.data.frame(results_MAE)
521
  results_table_ME<-as.data.frame(results_ME)
522
  results_table_R2<-as.data.frame(results_R2)
523
  results_table_RMSE_f<-as.data.frame(results_RMSE_f)
524
  results_table_MAE_f<-as.data.frame(results_MAE_f)
525
  
526
  results_table_AIC<-as.data.frame(results_AIC)
527
  results_table_GCV<-as.data.frame(results_GCV)
528
  results_table_DEV<-as.data.frame(results_DEV)
529
  
530
  tb_metrics1<-rbind(results_table_RMSE,results_table_MAE, results_table_ME, results_table_R2,results_table_RMSE_f,results_table_MAE_f)   #
531
  tb_metrics2<-rbind(results_table_AIC,results_table_GCV, results_table_DEV)
532
  cname<-c("dates","ns","metric","mod1", "mod2","mod3", "mod4", "mod5", "mod6", "mod7","mod8","mod9")
533
  colnames(tb_metrics1)<-cname
534
  cname<-c("dates","ns","metric","mod1", "mod2","mod3", "mod4", "mod5", "mod6", "mod7","mod8")
535
  colnames(tb_metrics2)<-cname
536
  #colnames(results_table_RMSE)<-cname
537
  #colnames(results_table_RMSE_f)<-cname
538
  #tb_diagnostic1<-results_table_RMSE      #measures of validation
539
  #tb_diagnostic2<-results_table_RMSE_f    #measures of fit
540
  
541
  #write.table(tb_diagnostic1, file= paste(path,"/","results_fusion_Assessment_measure1",out_prefix,".txt",sep=""), sep=",")
542
  
543
  #}  
544
  print(paste(dates[i],"processed"))
545
  # end of the for loop1
546
  mod_obj<-list(mod1,mod2,mod3,mod4,mod5,mod6,mod7,mod8,mod9a,mod9b)
547
  names(mod_obj)<-c("mod1","mod2","mod3","mod4","mod5","mod6","mod7","mod8","mod9a","mod9b")
548
  #results_list<-list(data_s,data_v,tb_metrics1,tb_metrics2)
549
  results_list<-list(data_s,data_v,tb_metrics1,tb_metrics2,mod_obj)
550
  names(results_list)<-c("data_s","data_v","tb_metrics1","tb_metrics2","mod_obj")
551
  save(results_list,file= paste(path,"/","results_list_metrics_objects_",dates[i],out_prefix,".RData",sep=""))
552
  return(results_list)
553
  #return(tb_diagnostic1)
554
}
(19-19/33)