Project

General

Profile

Download (29.8 KB) Statistics
| Branch: | Revision:
1
runGAMFusion <- function(i) {            # loop over dates
2
  
3
  date<-strptime(sampling_dat$date[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",layerNames(s_raster)) #Find the position of the layer with name "LST", if not present pos=NA
10
  s_raster<-dropLayer(s_raster,pos)      # If it exists drop layer
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
  #Screen for extreme values" 10/30
15
  min_val<-(-15+273.16) #if values less than -15C then screen out (note the Kelvin units that will need to be changed later in all datasets)
16
  r1[r1 < (min_val)]<-NA
17
  s_raster<-addLayer(s_raster,r1)            #Adding current month
18
  
19
  ###Regression part 1: Creating a validation dataset by creating training and testing datasets
20
  
21
  mod_LST <-ghcn.subsets[[i]][,match(LST_month, names(ghcn.subsets[[i]]))]  #Match interpolation date and monthly LST average
22
  ghcn.subsets[[i]] = transform(ghcn.subsets[[i]],LST = mod_LST)            #Add the variable LST to the subset dataset
23
  dst$LST<-dst[[LST_month]]
24
  #n<-nrow(ghcn.subsets[[i]])
25
  #ns<-n-round(n*prop)   #Create a sample from the data frame with 70% of the rows
26
  #nv<-n-ns              #create a sample for validation with prop of the rows
27
  #ind.training <- sample(nrow(ghcn.subsets[[i]]), size=ns, replace=FALSE) #This selects the index position for 70% of the rows taken randomly
28
  ind.training<-sampling[[i]]
29
  ind.testing <- setdiff(1:nrow(ghcn.subsets[[i]]), ind.training)
30
  data_s <- ghcn.subsets[[i]][ind.training, ]   #Training dataset currently used in the modeling
31
  data_v <- ghcn.subsets[[i]][ind.testing, ]    #Testing/validation dataset using input sampling
32
  
33
  ns<-nrow(data_s)
34
  nv<-nrow(data_v)
35
  #i=1
36
  date_proc<-sampling_dat$date[i]
37
  date_proc<-strptime(sampling_dat$date[i], "%Y%m%d")   # interpolation date being processed
38
  mo<-as.integer(strftime(date_proc, "%m"))          # current month of the date being processed
39
  day<-as.integer(strftime(date_proc, "%d"))
40
  year<-as.integer(strftime(date_proc, "%Y"))
41

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

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

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

    
267
  if (bias_prediction==0){
268
    data_v$y_var<-data_v[[y_var_name]]
269
    data_s$y_var<-data_s[[y_var_name]]
270
  }
271
  
272
  #Model and response variable can be changed without affecting the script
273
  
274
  list_formulas<-vector("list",nmodels)
275
  
276
  list_formulas[[1]] <- as.formula("y_var ~ s(ELEV_SRTM)", env=.GlobalEnv)
277
  list_formulas[[2]] <- as.formula("y_var ~ s(LST)", env=.GlobalEnv)
278
  list_formulas[[3]] <- as.formula("y_var ~ s(ELEV_SRTM,LST)", env=.GlobalEnv)
279
  list_formulas[[4]] <- as.formula("y_var ~ s(lat) + s(lon)+ s(ELEV_SRTM)", env=.GlobalEnv)
280
  list_formulas[[5]] <- as.formula("y_var ~ s(lat,lon,ELEV_SRTM)", env=.GlobalEnv)
281
  list_formulas[[6]] <- as.formula("y_var ~ s(lat,lon) + s(ELEV_SRTM) + s(Northness_w,Eastness_w) + s(LST)", env=.GlobalEnv)
282
  list_formulas[[7]] <- as.formula("y_var ~ s(lat,lon) + s(ELEV_SRTM) + s(Northness_w,Eastness_w) + s(LST) + s(LC1)", env=.GlobalEnv)
283
  list_formulas[[8]] <- as.formula("y_var ~ s(lat,lon) + s(ELEV_SRTM) + s(Northness_w,Eastness_w) + s(LST) + s(LC3)", env=.GlobalEnv)
284
  list_formulas[[9]] <- as.formula("y_var ~ s(lat,lon) + s(ELEV_SRTM) + s(Northness_w,Eastness_w) + s(LST) + s(DISTOC)", env=.GlobalEnv)
285
  
286
  #list_formulas[[1]] <- as.formula("y_var ~ s(ELEV_SRTM)", env=.GlobalEnv)
287
  #list_formulas[[2]] <- as.formula("y_var ~ s(lat,lon)", env=.GlobalEnv)
288
  #list_formulas[[3]] <- as.formula("y_var~ s(lat,lon,ELEV_SRTM)", env=.GlobalEnv)
289
  #list_formulas[[4]] <- as.formula("y_var~ s(lat) + s (lon) + s (ELEV_SRTM) + s(DISTOC)", env=.GlobalEnv)
290
  #list_formulas[[5]] <- as.formula("y_var~ s(lat,lon,ELEV_SRTM) + s(Northness) + s (Eastness) + s(DISTOC)", env=.GlobalEnv)
291
  #list_formulas[[6]] <- as.formula("y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC)", env=.GlobalEnv)
292
  
293
  if (bias_prediction==1){
294
    #mod1<- try(gam(formula1, data=data_month))
295
    #mod2<- try(gam(formula2, data=data_month)) #modified nesting....from 3 to 2
296
    #mod3<- try(gam(formula3, data=data_month))
297
    #mod4<- try(gam(formula4, data=data_month))
298
    #mod5<- try(gam(formula5, data=data_month))
299
    #mod6<- try(gam(formula6, data=data_month))
300
    #mod7<- try(gam(formula7, data=data_month))
301
    #mod8<- try(gam(formula8, data=data_month)) 
302
    
303
    for (j in 1:nmodels){
304
      formula<-list_formulas[[j]]
305
      mod<- try(gam(formula, data=data_month))
306
      model_name<-paste("mod",j,sep="")
307
      assign(model_name,mod) 
308
    }
309
    
310
  } else if (bias_prediction==0){      #Use daily data for direct prediction using GAM
311
    
312
    #mod1<- try(gam(formula1, data=data_s))
313
    #mod2<- try(gam(formula2, data=data_s)) #modified nesting....from 3 to 2
314
    #mod3<- try(gam(formula3, data=data_s))
315
    #mod4<- try(gam(formula4, data=data_s))
316
    #mod5<- try(gam(formula5, data=data_s))
317
    #mod6<- try(gam(formula6, data=data_s))
318
    #mod7<- try(gam(formula7, data=data_s))
319
    #mod8<- try(gam(formula8, data=data_s))
320
    
321
    for (j in 1:nmodels){
322
      formula<-list_formulas[[j]]
323
      mod<- try(gam(formula, data=data_s))
324
      model_name<-paste("mod",j,sep="")
325
      assign(model_name,mod) 
326
    }
327
    
328
  }
329

    
330
  #Added
331
  #tmax_predicted=themolst+daily_delta_rast-bias_rast #Final surface?? but daily_rst
332
  
333
  ### Added by benoit
334
  #Store results using TPS
335
  j=nmodels+1
336
  results_RMSE[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
337
  results_RMSE[2]<- ns          #number of stations used in the training stage
338
  results_RMSE[3]<- "RMSE"
339

    
340
  results_RMSE[j+3]<- rmse  #Storing RMSE for the model j
341
  
342
  results_RMSE_f[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
343
  results_RMSE_f[2]<- ns          #number of stations used in the training stage
344
  results_RMSE_f[3]<- "RMSE_f"
345
  results_RMSE_f[j+3]<- rmse_fit  #Storing RMSE for the model j
346
  
347
  results_MAE_f[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
348
  results_MAE_f[2]<- ns          #number of stations used in the training stage
349
  results_MAE_f[3]<- "RMSE_f"
350
  results_MAE_f[j+3]<- mae_fit  #Storing RMSE for the model j
351

    
352
  results_MAE[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
353
  results_MAE[2]<- ns          #number of stations used in the training stage
354
  results_MAE[3]<- "MAE"
355
  results_MAE[j+3]<- mae  #Storing RMSE for the model j
356

    
357
  results_ME[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
358
  results_ME[2]<- ns          #number of stations used in the training stage
359
  results_ME[3]<- "ME"
360
  results_ME[j+3]<- me  #Storing RMSE for the model j
361
  
362
  results_R2[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
363
  results_R2[2]<- ns          #number of stations used in the training stage
364
  results_R2[3]<- "R2"
365
  results_R2[j+3]<- r2  #Storing RMSE for the model j
366
  
367
  #ns<-nrow(data_s) #This is added to because some loss of data might have happened because of the averaging...
368
  #nv<-nrow(data_v)
369
  
370
  pred_mod<-paste("pred_mod",j,sep="")
371
  #Adding the results back into the original dataframes.
372
  data_s[[pred_mod]]<-sta_pred_data_s
373
  data_v[[pred_mod]]<-sta_pred 
374
  
375
  #Model assessment: RMSE and then krig the residuals....!
376
  
377
  res_mod_s<- data_s$dailyTmax - data_s[[pred_mod]]           #Residuals from kriging training
378
  res_mod_v<- data_v$dailyTmax - data_v[[pred_mod]]           #Residuals from kriging validation
379
  
380
  name2<-paste("res_mod",j,sep="")
381
  data_v[[name2]]<-as.numeric(res_mod_v)
382
  data_s[[name2]]<-as.numeric(res_mod_s)
383
  
384
  mod_obj<-vector("list",nmodels+2)  #This will contain the model objects fitting: 10/30
385
  mod_obj[[nmodels+1]]<-mod_kr_month  #Storing climatology object
386
  mod_obj[[nmodels+2]]<-mod_kr_day  #Storing delta object
387
  
388
  for (j in 1:nmodels){
389
    
390
    ##Model assessment: specific diagnostic/metrics for GAM
391
    
392
    name<-paste("mod",j,sep="")  #modj is the name of The "j" model (mod1 if j=1) 
393
    mod<-get(name)               #accessing GAM model ojbect "j"
394
    mod_obj[[j]]<-mod  #storing current model object
395
    
396
    #If mod "j" is not a model object
397
    if (inherits(mod,"try-error")) {
398
      results_AIC[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
399
      results_AIC[2]<- ns        #number of stations used in the training stage
400
      results_AIC[3]<- "AIC"
401
      results_AIC[j+3]<- NA
402
      
403
      results_GCV[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
404
      results_GCV[2]<- ns        #number of stations used in the training 
405
      results_GCV[3]<- "GCV"
406
      results_GCV[j+3]<- NA
407
      
408
      results_DEV[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
409
      results_DEV[2]<- ns        #number of stations used in the training stage
410
      results_DEV[3]<- "DEV"
411
      results_DEV[j+3]<- NA
412
      
413
      results_RMSE_f[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
414
      results_RMSE_f[2]<- ns        #number of stations used in the training stage
415
      results_RMSE_f[3]<- "RSME_f"
416
      results_RMSE_f[j+3]<- NA
417
      
418
      results_MAE_f[1]<- sampling_dat$date[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]<-NA
422
      
423
      results_RMSE[1]<- sampling_dat$date[i]    #storing the interpolation dates in the first column
424
      results_RMSE[2]<- ns          #number of stations used in the training stage
425
      results_RMSE[3]<- "RMSE"
426
      results_RMSE[j+3]<- NA  #Storing RMSE for the model j
427
      results_MAE[1]<- sampling_dat$date[i]     #storing the interpolation dates in the first column
428
      results_MAE[2]<- ns           #number of stations used in the training stage
429
      results_MAE[3]<- "MAE"
430
      results_MAE[j+3]<- NA    #Storing MAE for the model j
431
      results_ME[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
432
      results_ME[2]<- ns            #number of stations used in the training stage
433
      results_ME[3]<- "ME"
434
      results_ME[j+3]<- NA      #Storing ME for the model j
435
      results_R2[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
436
      results_R2[2]<- ns            #number of stations used in the training stage
437
      results_R2[3]<- "R2"
438
      
439
      
440
      results_R2[j+3]<- NA      #Storing R2 for the model j
441
      
442
    }
443
    
444
    #If mod is a modelobject
445
    
446
    #If mod "j" is not a model object
447
    if (inherits(mod,"gam")) {
448
      
449
      results_AIC[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
450
      results_AIC[2]<- ns        #number of stations used in the training stage
451
      results_AIC[3]<- "AIC"
452
      results_AIC[j+3]<- AIC (mod)
453
      
454
      results_GCV[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
455
      results_GCV[2]<- ns        #number of stations used in the training 
456
      results_GCV[3]<- "GCV"
457
      results_GCV[j+3]<- mod$gcv.ubre
458
      
459
      results_DEV[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
460
      results_DEV[2]<- ns        #number of stations used in the training stage
461
      results_DEV[3]<- "DEV"
462
      results_DEV[j+3]<- mod$deviance
463
      
464
      y_var_fit= mod$fit
465
    
466
      results_RMSE_f[1]<- sampling_dat$date[i]  #storing the interpolation dates in the first column
467
      results_RMSE_f[2]<- ns        #number of stations used in the training stage
468
      results_RMSE_f[3]<- "RSME_f"
469
      #results_RMSE_f[j+3]<- sqrt(sum((y_var_fit-data_s$y_var)^2)/ns)
470
      results_RMSE_f[j+3]<-sqrt(mean(mod$residuals^2,na.rm=TRUE))
471
      
472
      results_MAE_f[1]<- sampling_dat$date[i]  #storing the interpolation sampling_dat$date in the first column
473
      results_MAE_f[2]<- ns        #number of stations used in the training stage
474
      results_MAE_f[3]<- "MAE_f"
475
      #results_MAE_f[j+3]<-sum(abs(y_var_fit-data_s$y_var))/ns
476
      results_MAE_f[j+3]<-mean(abs(mod$residuals),na.rm=TRUE)
477
      
478
      ##Model assessment: general diagnostic/metrics
479
      ##validation: using the testing data
480
      if (predval==1) {
481
      
482
        ##Model assessment: specific diagnostic/metrics for GAM
483
        
484
        name<-paste("mod",j,sep="")  #modj is the name of The "j" model (mod1 if j=1) 
485
        mod<-get(name)               #accessing GAM model ojbect "j"
486
        
487
        s_sgdf<-as(s_raster,"SpatialGridDataFrame") #Conversion to spatial grid data frame
488
        
489
        rpred<- predict(mod, newdata=s_sgdf, se.fit = TRUE) #Using the coeff to predict new values.
490
        y_pred<-rpred$fit #rpred is a list with fit being and array
491
        raster_pred<-r1
492
        layerNames(raster_pred)<-"y_pred"
493
        values(raster_pred)<-as.numeric(y_pred)
494
        
495
        if (bias_prediction==1){
496
          data_name<-paste("predicted_mod",j,"_",sampling_dat$date[i],"_",sampling_dat$prop[i],
497
                           "_",sampling_dat$run_samp[i],sep="")
498
          raster_name<-paste("GAM_bias_",data_name,out_prefix,".rst", sep="")
499
          writeRaster(raster_pred, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
500
          bias_rast<-raster_pred
501
          
502
          raster_pred=themolst+daily_delta_rast-bias_rast #Final surface  as a raster layer...wiht daily surface calculated earlier...
503
          layerNames(raster_pred)<-"y_pred"
504
          #=themolst+daily_delta_rast-bias_rast #Final surface  as a raster layer...
505
          
506
          data_name<-paste("predicted_mod",j,"_",sampling_dat$date[i],"_",sampling_dat$prop[i],
507
                           "_",sampling_dat$run_samp[i],sep="")
508
          raster_name<-paste("GAM_bias_tmax_",data_name,out_prefix,".rst", sep="")
509
          writeRaster(raster_pred, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
510
          
511
        }
512
        
513
        if (bias_prediction==0){
514
          data_name<-paste("predicted_mod",j,"_",sampling_dat$date[i],"_",sampling_dat$prop[i],
515
                           "_",sampling_dat$run_samp[i],sep="")
516
          raster_name<-paste("GAM_",data_name,out_prefix,".rst", sep="")
517
          writeRaster(raster_pred, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
518
          #writeRaster(r2, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
519
          
520
        }
521
        
522
        
523
        pred_sgdf<-as(raster_pred,"SpatialGridDataFrame") #Conversion to spatial grid data frame
524
        #rpred_val_s <- overlay(raster_pred,data_s)             #This overlays the kriged surface tmax and the location of weather stations
525
        
526
        rpred_val_s <- overlay(pred_sgdf,data_s)             #This overlays the interpolated surface tmax and the location of weather stations
527
        rpred_val_v <- overlay(pred_sgdf,data_v)             #This overlays the interpolated surface tmax and the location of weather stations
528
        
529
        pred_mod<-paste("pred_mod",j,sep="")
530
        #Adding the results back into the original dataframes.
531
        data_s[[pred_mod]]<-rpred_val_s$y_pred
532
        
533
        data_v[[pred_mod]]<-rpred_val_v$y_pred  
534
        
535
        #Model assessment: RMSE and then krig the residuals....!
536
        
537
        res_mod_s<-data_s[[y_var_name]] - data_s[[pred_mod]] #residuals from modeling training
538
        res_mod_v<-data_v[[y_var_name]] - data_v[[pred_mod]] #residuals from modeling validation
539
        
540
      }
541
      
542
      if (predval==0) {
543
      
544
        y_mod<- predict(mod, newdata=data_v, se.fit = TRUE) #Using the coeff to predict new values.
545
        
546
        pred_mod<-paste("pred_mod",j,sep="")
547
        #Adding the results back into the original dataframes.
548
        data_s[[pred_mod]]<-as.numeric(mod$fit)
549
        data_v[[pred_mod]]<-as.numeric(y_mod$fit)
550
        
551
        #Model assessment: RMSE and then krig the residuals....!
552
        
553
        #res_mod_s<- data_s$y_var - data_s[[pred_mod]]           #Residuals from modeling training
554
        #res_mod_v<- data_v$y_var - data_v[[pred_mod]]           #Residuals from modeling validation
555
        res_mod_s<-data_s[[y_var_name]] - data_s[[pred_mod]]
556
        res_mod_v<-data_v[[y_var_name]] - data_v[[pred_mod]]
557
        
558
      }
559

    
560
      ####ADDED ON JULY 20th
561
      res_mod<-res_mod_v
562
      
563
      #RMSE_mod <- sqrt(sum(res_mod^2)/nv)                 #RMSE FOR REGRESSION STEP 1: GAM  
564
      RMSE_mod<- sqrt(mean(res_mod^2,na.rm=TRUE))
565
      #MAE_mod<- sum(abs(res_mod),na.rm=TRUE)/(nv-sum(is.na(res_mod)))        #MAE from kriged surface validation
566
      MAE_mod<- mean(abs(res_mod), na.rm=TRUE)
567
      #ME_mod<- sum(res_mod,na.rm=TRUE)/(nv-sum(is.na(res_mod)))                    #ME, Mean Error or bias FOR REGRESSION STEP 1: GAM
568
      ME_mod<- mean(res_mod,na.rm=TRUE)                            #ME, Mean Error or bias FOR REGRESSION STEP 1: GAM
569
      #R2_mod<- cor(data_v$y_var,data_v[[pred_mod]])^2              #R2, coef. of var FOR REGRESSION STEP 1: GAM
570
      R2_mod<- cor(data_v$y_var,data_v[[pred_mod]], use="complete")^2
571
      results_RMSE[1]<- sampling_dat$date[i]    #storing the interpolation sampling_dat$date in the first column
572
      results_RMSE[2]<- ns          #number of stations used in the training stage
573
      results_RMSE[3]<- "RMSE"
574
      results_RMSE[j+3]<- RMSE_mod  #Storing RMSE for the model j
575
      results_MAE[1]<- sampling_dat$date[i]     #storing the interpolation dates in the first column
576
      results_MAE[2]<- ns           #number of stations used in the training stage
577
      results_MAE[3]<- "MAE"
578
      results_MAE[j+3]<- MAE_mod    #Storing MAE for the model j
579
      results_ME[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
580
      results_ME[2]<- ns            #number of stations used in the training stage
581
      results_ME[3]<- "ME"
582
      results_ME[j+3]<- ME_mod      #Storing ME for the model j
583
      results_R2[1]<- sampling_dat$date[i]      #storing the interpolation dates in the first column
584
      results_R2[2]<- ns            #number of stations used in the training stage
585
      results_R2[3]<- "R2"
586
      results_R2[j+3]<- R2_mod      #Storing R2 for the model j
587
      
588
      #Saving residuals and prediction in the dataframes: tmax predicted from GAM
589

    
590
      name2<-paste("res_mod",j,sep="")
591
      data_v[[name2]]<-as.numeric(res_mod_v)
592
      data_s[[name2]]<-as.numeric(res_mod_s)
593
      #end of loop calculating RMSE
594
    }
595
  }
596
  
597
  #if (i==length(dates)){
598
  
599
  #Specific diagnostic measures related to the testing datasets
600

    
601
  results_table_RMSE<-as.data.frame(results_RMSE)
602
  results_table_MAE<-as.data.frame(results_MAE)
603
  results_table_ME<-as.data.frame(results_ME)
604
  results_table_R2<-as.data.frame(results_R2)
605
  results_table_RMSE_f<-as.data.frame(results_RMSE_f)
606
  results_table_MAE_f<-as.data.frame(results_MAE_f)
607
  
608
  results_table_AIC<-as.data.frame(results_AIC)
609
  results_table_GCV<-as.data.frame(results_GCV)
610
  results_table_DEV<-as.data.frame(results_DEV)
611
  
612
  tb_metrics1<-rbind(results_table_RMSE,results_table_MAE, results_table_ME, results_table_R2,results_table_RMSE_f,results_table_MAE_f)   #
613
  tb_metrics2<-rbind(results_table_AIC,results_table_GCV, results_table_DEV)
614
  
615
  #Preparing labels 10/30
616
  mod_labels<-rep("mod",nmodels+1)
617
  index<-as.character(1:(nmodels+1))
618
  mod_labels<-paste(mod_labels,index,sep="")
619
  cname<-c("dates","ns","metric", mod_labels)
620
  #cname<-c("dates","ns","metric","mod1", "mod2","mod3", "mod4", "mod5", "mod6", "mod7","mod8","mod9")
621
  colnames(tb_metrics1)<-cname
622
  #cname<-c("dates","ns","metric","mod1", "mod2","mod3", "mod4", "mod5", "mod6", "mod7","mod8")
623
  #colnames(tb_metrics2)<-cname
624
  colnames(tb_metrics2)<-cname[1:(nmodels+3)]
625
  
626
  #write.table(tb_diagnostic1, file= paste(path,"/","results_fusion_Assessment_measure1",out_prefix,".txt",sep=""), sep=",")
627
  
628
  #}  
629
  print(paste(sampling_dat$date[i],"processed"))
630
  # end of the for loop1
631
  #mod_obj<-list(mod1,mod2,mod3,mod4,mod5,mod6,mod7,mod8,mod9a,mod9b)
632
  #names(mod_obj)<-c("mod1","mod2","mod3","mod4","mod5","mod6","mod7","mod8","mod9a","mod9b")
633
  mod_labels_kr<-c("mod_kr_month", "mod_kr_day")
634
  names(mod_obj)<-c(mod_labels[1:nmodels],mod_labels_kr)
635
  results_list<-list(data_s,data_v,tb_metrics1,tb_metrics2,mod_obj,data_month,list_formulas)
636
  names(results_list)<-c("data_s","data_v","tb_metrics1","tb_metrics2","mod_obj","data_month","formulas")
637
  
638
  #results_list<-list(data_s,data_v,tb_metrics1,tb_metrics2)
639
  #results_list<-list(data_s,data_v,tb_metrics1,tb_metrics2,mod_obj,sampling_dat[i,],data_month)
640
  #names(results_list)<-c("data_s","data_v","tb_metrics1","tb_metrics2","mod_obj","sampling_dat","data_month")
641
  save(results_list,file= paste(path,"/","results_list_metrics_objects_",sampling_dat$date[i],"_",sampling_dat$prop[i],
642
                                "_",sampling_dat$run_samp[i],out_prefix,".RData",sep=""))
643
  return(results_list)
644
  #return(tb_diagnostic1)
645
}
(8-8/33)