Project

General

Profile

Download (24.1 KB) Statistics
| Branch: | Revision:
1
##################  Functions for use in the raster prediction stage   #######################################
2
############################ Interpolation in a given tile/region ##########################################
3
#This script contains 5 functions used in the interpolation of temperature in the specfied study/processing area:                             
4
# 1)predict_raster_model<-function(in_models,r_stack,out_filename)                                                             
5
# 2)fit_models<-function(list_formulas,data_training)           
6
# 3)runClim_KGCAI<-function(j,list_param) : function that peforms GAM CAI method
7
# 4)runClim_KGFusion<-function(j,list_param) function for monthly step (climatology) in the fusion method
8
# 5)runGAMFusion <- function(i,list_param) : daily step for fusion method, perform daily prediction
9
#
10
#AUTHOR: Benoit Parmentier                                                                       
11
#DATE: 07/30/2013                                                                                 
12
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#363--   
13

    
14
##Comments and TODO:
15
#This script is meant to be for general processing tile by tile or region by region.
16
# Note that the functions are called from GAM_fusion_analysis_raster_prediction_mutlisampling.R.
17
# This will be expanded to other methods.
18
##################################################################################################
19

    
20

    
21
predict_raster_model<-function(in_models,r_stack,out_filename){
22
  #This functions performs predictions on a raster grid given input models.
23
  #Arguments: list of fitted models, raster stack of covariates
24
  #Output: spatial grid data frame of the subset of tiles
25
  list_rast_pred<-vector("list",length(in_models))
26
  for (i in 1:length(in_models)){
27
    mod <-in_models[[i]] #accessing GAM model ojbect "j"
28
    raster_name<-out_filename[[i]]
29
    if (inherits(mod,"gam")) {           #change to c("gam","autoKrige")
30
      raster_pred<- predict(object=r_stack,model=mod,na.rm=FALSE) #Using the coeff to predict new values.
31
      names(raster_pred)<-"y_pred"  
32
      writeRaster(raster_pred, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
33
      #print(paste("Interpolation:","mod", j ,sep=" "))
34
      list_rast_pred[[i]]<-raster_name
35
    }
36
  }
37
  if (inherits(mod,"try-error")) {
38
    print(paste("no gam model fitted:",mod[1],sep=" ")) #change message for any model type...
39
  }
40
  return(list_rast_pred)
41
}
42

    
43
fit_models<-function(list_formulas,data_training){
44
  #This functions several models and returns model objects.
45
  #Arguments: - list of formulas for GAM models
46
  #           - fitting data in a data.frame or SpatialPointDataFrame
47
  #Output: list of model objects 
48
  list_fitted_models<-vector("list",length(list_formulas))
49
  for (k in 1:length(list_formulas)){
50
    formula<-list_formulas[[k]]
51
    mod<- try(gam(formula, data=data_training)) #change to any model!!
52
    #mod<- try(autoKrige(formula, input_data=data_s,new_data=s_sgdf,data_variogram=data_s))
53
    model_name<-paste("mod",k,sep="")
54
    assign(model_name,mod) 
55
    list_fitted_models[[k]]<-mod
56
  }
57
  return(list_fitted_models) 
58
}
59

    
60
####
61
#TODO:
62
#Add log file and calculate time and sizes for processes-outputs
63
#Can combine runClim_KGFusion and runClim_KGCAI
64
runClim_KGCAI <-function(j,list_param){
65

    
66
  #Make this a function with multiple argument that can be used by mcmapply??
67
  #Arguments: 
68
  #1)list_index: j 
69
  #2)covar_rast: covariates raster images used in the modeling
70
  #3)covar_names: names of input variables 
71
  #4)lst_avg: list of LST climatogy names, may be removed later on
72
  #5)list_models: list input models for bias calculation
73
  #6)dst: data at the monthly time scale
74
  #7)var: TMAX or TMIN, variable being interpolated
75
  #8)y_var_name: output name, not used at this stage
76
  #9)out_prefix
77
  #10) out_path
78
  
79
  #The output is a list of four shapefile names produced by the function:
80
  #1) clim: list of output names for raster climatogies 
81
  #2) data_month: monthly training data for bias surface modeling
82
  #3) mod: list of model objects fitted 
83
  #4) formulas: list of formulas used in bias modeling
84
    
85
  ### PARSING INPUT ARGUMENTS
86
  #list_param_runGAMFusion<-list(i,clim_yearlist,sampling_obj,var,y_var_name, out_prefix)
87
    
88
  index<-list_param$j
89
  s_raster<-list_param$covar_rast
90
  covar_names<-list_param$covar_names
91
  lst_avg<-list_param$lst_avg
92
  list_models<-list_param$list_models
93
  dst<-list_param$dst #monthly station dataset
94
  var<-list_param$var
95
  y_var_name<-list_param$y_var_name
96
  out_prefix<-list_param$out_prefix
97
  out_path<-list_param$out_path
98
  
99
  #Model and response variable can be changed without affecting the script
100
  prop_month<-0 #proportion retained for validation...
101
  run_samp<-1 #sample number, can be introduced later...
102
  
103
  #### STEP 2: PREPARE DATA
104
    
105
  data_month<-dst[dst$month==j,] #Subsetting dataset for the relevant month of the date being processed
106
  LST_name<-lst_avg[j] # name of LST month to be matched
107
  data_month$LST<-data_month[[LST_name]]
108
  
109
  #TMax to model..., add precip later
110
  if (var=="TMAX"){   
111
    data_month$y_var<-data_month$TMax #Adding TMax as the variable modeled
112
  }
113
  if (var=="TMIN"){   
114
    data_month$y_var<-data_month$TMin #Adding TMin as the variable modeled
115
  }
116
  #Fit gam models using data and list of formulas
117
  
118
  list_formulas<-lapply(list_models,as.formula,env=.GlobalEnv) #mulitple arguments passed to lapply!!
119
  cname<-paste("mod",1:length(list_formulas),sep="") #change to more meaningful name?
120
  
121
  #mod_list<-fit_models(list_formulas,data_month) #only gam at this stage
122
  #cname<-paste("mod",1:length(mod_list),sep="") #change to more meaningful name?
123
  
124
  #Adding layer LST to the raster stack  
125
  
126
  pos<-match("LST",names(s_raster)) #Find the position of the layer with name "LST", if not present pos=NA
127
  s_raster<-dropLayer(s_raster,pos)      # If it exists drop layer
128
  LST<-subset(s_raster,LST_name)
129
  names(LST)<-"LST"
130
  s_raster<-addLayer(s_raster,LST)            #Adding current month
131
  
132
  #Now generate file names for the predictions...
133
  list_out_filename<-vector("list",length(list_formulas))
134
  names(list_out_filename)<-cname  
135
  
136
  for (k in 1:length(list_out_filename)){
137
    #j indicate which month is predicted
138
    data_name<-paste(var,"_clim_month_",j,"_",cname[k],"_",prop_month,
139
                     "_",run_samp,sep="")
140
    raster_name<-file.path(out_path,paste("CAI_",data_name,out_prefix,".tif", sep=""))
141
    list_out_filename[[k]]<-raster_name
142
  }
143
  
144
  ## Select the relevant method...
145
  
146
  if (interpolation_method=="gam_CAI"){
147
    
148
    #First fitting
149
    mod_list<-fit_models(list_formulas,data_month) #only gam at this stage
150
    names(mod_list)<-cname
151
    
152
    #Second predict values for raster image...by providing fitted model list, raster brick and list of output file names
153
    #now predict values for raster image...
154
    rast_clim_list<-predict_raster_model(mod_list,s_raster,list_out_filename)
155
    names(rast_clim_list)<-cname
156
    #Some models will not be predicted because of the lack of training data...remove empty string from list of models
157
        
158
  }
159
  
160
  
161
  if (interpolation_method %in% c("kriging_CAI","gwr_CAI")){
162
    
163
    if(interpolation_method=="kriging_CAI"){
164
      method_interp <- "kriging"
165
    }else{
166
      method_interp <- "gwr"
167
    }
168
    #Call function to fit and predict gwr and/or kriging
169
    #month_prediction_obj<-predict_auto_krige_raster_model(list_formulas,s_raster,data_month,list_out_filename)
170
    month_prediction_obj<-predict_autokrige_gwr_raster_model(method_interp,list_formulas,s_raster,data_month,list_out_filename)
171
    
172
    mod_list <-month_prediction_obj$list_fitted_models
173
    rast_clim_list <-month_prediction_obj$list_rast_pred
174
    names(rast_clim_list)<-cname
175
  }
176
  
177
  rast_clim_list<-rast_clim_list[!sapply(rast_clim_list,is.null)] #remove NULL elements in list
178
  
179
  #Adding Kriging for Climatology options
180
  
181
  clim_xy<-coordinates(data_month)
182
  fitclim<-Krig(clim_xy,data_month$y_var,theta=1e5) #use TPS or krige 
183
  #fitclim<-Krig(clim_xy,data_month$TMax,theta=1e5) #use TPS or krige 
184
  mod_krtmp1<-fitclim
185
  model_name<-"mod_kr"
186
  
187
  clim_rast<-interpolate(LST,fitclim) #interpolation using function from raster package
188
  
189
  #Write out modeled layers
190
  
191
  data_name<-paste(var,"_clim_month_",j,"_",model_name,"_",prop_month,
192
                   "_",run_samp,sep="")
193
  raster_name_clim<-file.path(out_path,paste("CAI_",data_name,out_prefix,".tif", sep=""))
194
  writeRaster(clim_rast, filename=raster_name_clim,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
195
  
196
  #Adding to current objects
197
  mod_list[[model_name]]<-mod_krtmp1
198
  #rast_bias_list[[model_name]]<-raster_name_bias
199
  rast_clim_list[[model_name]]<-raster_name_clim
200
  
201
  #Prepare object to return
202
  clim_obj<-list(rast_clim_list,data_month,mod_list,list_formulas)
203
  names(clim_obj)<-c("clim","data_month","mod","formulas")
204
  
205
  save(clim_obj,file= file.path(out_path,paste("clim_obj_CAI_month_",j,"_",var,"_",out_prefix,".RData",sep="")))
206
  
207
  return(clim_obj) 
208
}
209
#
210

    
211
runClim_KGFusion<-function(j,list_param){
212
  
213
  #Make this a function with multiple argument that can be used by mcmapply??
214
  #Arguments: 
215
  #1)list_index: j 
216
  #2)covar_rast: covariates raster images used in the modeling
217
  #3)covar_names: names of input variables 
218
  #4)lst_avg: list of LST climatogy names, may be removed later on
219
  #5)list_models: list input models for bias calculation
220
  #6)dst: data at the monthly time scale
221
  #7)var: TMAX or TMIN, variable being interpolated
222
  #8)y_var_name: output name, not used at this stage
223
  #9)out_prefix
224
  #
225
  #The output is a list of four shapefile names produced by the function:
226
  #1) clim: list of output names for raster climatogies 
227
  #2) data_month: monthly training data for bias surface modeling
228
  #3) mod: list of model objects fitted 
229
  #4) formulas: list of formulas used in bias modeling
230
  
231
  ### PARSING INPUT ARGUMENTS
232
  #list_param_runGAMFusion<-list(i,clim_yearlist,sampling_obj,var,y_var_name, out_prefix)
233
  
234
  index<-list_param$j
235
  s_raster<-list_param$covar_rast
236
  covar_names<-list_param$covar_names
237
  lst_avg<-list_param$lst_avg
238
  list_models<-list_param$list_models
239
  dst<-list_param$dst #monthly station dataset
240
  var<-list_param$var
241
  y_var_name<-list_param$y_var_name
242
  out_prefix<-list_param$out_prefix
243
  out_path<-list_param$out_path
244
  
245
  #Model and response variable can be changed without affecting the script
246
  prop_month<-0 #proportion retained for validation
247
  run_samp<-1 #This option can be added later on if/when neeeded
248
  
249
  #### STEP 2: PREPARE DATA
250
  
251
  data_month<-dst[dst$month==j,] #Subsetting dataset for the relevant month of the date being processed
252
  LST_name<-lst_avg[j] # name of LST month to be matched
253
  data_month$LST<-data_month[[LST_name]]
254
  
255
  #Adding layer LST to the raster stack  
256
  covar_rast<-s_raster
257
  #names(s_raster)<-covar_names
258
  pos<-match("LST",names(s_raster)) #Find the position of the layer with name "LST", if not present pos=NA
259
  s_raster<-dropLayer(s_raster,pos)      # If it exists drop layer
260
  LST<-subset(s_raster,LST_name)
261
  names(LST)<-"LST"
262
  s_raster<-addLayer(s_raster,LST)            #Adding current month
263
  
264
  #LST bias to model...
265
  if (var=="TMAX"){
266
    data_month$LSTD_bias<-data_month$LST-data_month$TMax
267
    data_month$y_var<-data_month$LSTD_bias #Adding bias as the variable modeled
268
  }
269
  if (var=="TMIN"){
270
    data_month$LSTD_bias<-data_month$LST-data_month$TMin
271
    data_month$y_var<-data_month$LSTD_bias #Adding bias as the variable modeled
272
  }
273
  
274
  #### STEP3:  NOW FIT AND PREDICT  MODEL
275
  
276
  list_formulas<-lapply(list_models,as.formula,env=.GlobalEnv) #mulitple arguments passed to lapply!!
277
  cname<-paste("mod",1:length(list_formulas),sep="") #change to more meaningful name?
278
  
279
  #Now generate file names for the predictions...
280
  list_out_filename<-vector("list",length(list_formulas))
281
  names(list_out_filename)<-cname  
282
  
283
  for (k in 1:length(list_out_filename)){
284
    #j indicate which month is predicted, var indicates TMIN or TMAX
285
    data_name<-paste(var,"_bias_LST_month_",j,"_",cname[k],"_",prop_month,
286
                     "_",run_samp,sep="")
287
    raster_name<-file.path(out_path,paste("fusion_",interpolation_method,"_",data_name,out_prefix,".tif", sep=""))
288
    list_out_filename[[k]]<-raster_name
289
  }
290
  
291
  ## Select the relevant method...
292
  
293
  if (interpolation_method=="gam_fusion"){
294
    
295
    #First fitting
296
    mod_list<-fit_models(list_formulas,data_month) #only gam at this stage
297
    names(mod_list)<-cname
298
  
299
    #Second predict values for raster image...by providing fitted model list, raster brick and list of output file names
300
    rast_bias_list<-predict_raster_model(mod_list,s_raster,list_out_filename)
301
    names(rast_bias_list)<-cname
302
    
303
  }
304
  
305

    
306
  if (interpolation_method %in% c("kriging_fusion","gwr_fusion")){
307
    
308
    if(interpolation_method=="kriging_fusion"){
309
      method_interp <- "kriging"
310
    }else{
311
      method_interp <- "gwr"
312
    }
313
    #Call funciton to fit and predict gwr and/or kriging
314
    #month_prediction_obj<-predict_auto_krige_raster_model(list_formulas,s_raster,data_month,list_out_filename)
315
    month_prediction_obj<-predict_autokrige_gwr_raster_model(method_interp,list_formulas,s_raster,data_month,list_out_filename)
316
    
317
    mod_list <-month_prediction_obj$list_fitted_models
318
    rast_bias_list <-month_prediction_obj$list_rast_pred
319
    names(rast_bias_list)<-cname
320
  }
321
  
322
  #Some modles will not be predicted...remove them
323
  rast_bias_list<-rast_bias_list[!sapply(rast_bias_list,is.null)] #remove NULL elements in list
324

    
325
  mod_rast<-stack(rast_bias_list)  #stack of bias raster images from models
326
  rast_clim_list<-vector("list",nlayers(mod_rast))
327
  names(rast_clim_list)<-names(rast_bias_list)
328
  for (k in 1:nlayers(mod_rast)){
329
    clim_fus_rast<-LST-subset(mod_rast,k)
330
    data_name<-paste(var,"_clim_LST_month_",j,"_",names(rast_clim_list)[k],"_",prop_month,
331
                     "_",run_samp,sep="")
332
    raster_name<-file.path(out_path,paste("fusion_",interpolation_method,"_",data_name,out_prefix,".tif", sep=""))
333
    rast_clim_list[[k]]<-raster_name
334
    writeRaster(clim_fus_rast, filename=raster_name,overwrite=TRUE)  #Wri
335
  }
336
  
337
  #### STEP 4:Adding Kriging for Climatology options
338
  
339
  bias_xy<-coordinates(data_month)
340
  #fitbias<-Krig(bias_xy,data_month$LSTD_bias,theta=1e5) #use TPS or krige 
341
  fitbias<-try(Krig(bias_xy,data_month$LSTD_bias,theta=1e5)) #use TPS or krige 
342
 
343
  model_name<-"mod_kr"
344

    
345
  if (inherits(fitbias,"Krig")){
346
    #Saving kriged surface in raster images
347
    bias_rast<-bias_rast<-interpolate(LST,fitbias) #interpolation using function from raster package
348
    data_name<-paste(var,"_bias_LST_month_",j,"_",model_name,"_",prop_month,
349
                     "_",run_samp,sep="")
350
    raster_name_bias<-file.path(out_path,paste("fusion_",data_name,out_prefix,".tif", sep=""))
351
    writeRaster(bias_rast, filename=raster_name_bias,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
352
    
353
    #now climatology layer
354
    clim_rast<-LST-bias_rast
355
    data_name<-paste(var,"_clim_LST_month_",j,"_",model_name,"_",prop_month,
356
                     "_",run_samp,sep="")
357
    raster_name_clim<-file.path(out_path,paste("fusion_",data_name,out_prefix,".tif", sep=""))
358
    writeRaster(clim_rast, filename=raster_name_clim,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
359
    #Adding to current objects
360
    mod_list[[model_name]]<-fitbias
361
    rast_bias_list[[model_name]]<-raster_name_bias
362
    rast_clim_list[[model_name]]<-raster_name_clim
363
  }
364
  
365
  if (inherits(fitbias,"try-error")){
366
    #NEED TO DEAL WITH THIS!!!
367
    
368
    #Adding to current objects
369
    mod_list[[model_name]]<-NULL
370
    rast_bias_list[[model_name]]<-NULL
371
    rast_clim_list[[model_name]]<-NULL
372
  }
373

    
374
  #### STEP 5: Prepare object and return
375
  
376
  clim_obj<-list(rast_bias_list,rast_clim_list,data_month,mod_list,list_formulas)
377
  names(clim_obj)<-c("bias","clim","data_month","mod","formulas")
378
  
379
  save(clim_obj,file= file.path(out_path,paste("clim_obj_month_",j,"_",var,"_",out_prefix,".RData",sep="")))
380
  
381
  return(clim_obj)
382
}
383

    
384
## Run function for kriging...?
385

    
386
#runGAMFusion <- function(i,list_param) {            # loop over dates
387
run_prediction_daily_deviation <- function(i,list_param) {            # loop over dates
388
  #This function produce daily prediction using monthly predicted clim surface.
389
  #The output is both daily prediction and daily deviation from monthly steps.
390
  
391
  #### Change this to allow explicitly arguments...
392
  #Arguments: 
393
  #1)index: loop list index for individual run/fit
394
  #2)clim_year_list: list of climatology files for all models...(12*nb of models)
395
  #3)sampling_obj: contains, data per date/fit, sampling information
396
  #4)dst: data at the monthly time scale
397
  #5)var: variable predicted -TMAX or TMIN
398
  #6)y_var_name: name of the variable predicted - dailyTMax, dailyTMin
399
  #7)out_prefix
400
  #8)out_path
401
  #
402
  #The output is a list of four shapefile names produced by the function:
403
  #1) list_temp: y_var_name
404
  #2) rast_clim_list: list of files for temperature climatology predictions
405
  #3) delta: list of files for temperature delta predictions
406
  #4) data_s: training data
407
  #5) data_v: testing data
408
  #6) sampling_dat: sampling information for the current prediction (date,proportion of holdout and sample number)
409
  #7) mod_kr: kriging delta fit, field package model object
410
  
411
  ### PARSING INPUT ARGUMENTS
412
  
413
  #list_param_runGAMFusion<-list(i,clim_yearlist,sampling_obj,var,y_var_name, out_prefix)
414
  rast_clim_yearlist<-list_param$clim_yearlist
415
  sampling_obj<-list_param$sampling_obj
416
  ghcn.subsets<-sampling_obj$ghcn_data_day
417
  sampling_dat <- sampling_obj$sampling_dat
418
  sampling <- sampling_obj$sampling_index
419
  var<-list_param$var
420
  y_var_name<-list_param$y_var_name
421
  out_prefix<-list_param$out_prefix
422
  dst<-list_param$dst #monthly station dataset
423
  out_path <-list_param$out_path
424
  
425
  ##########
426
  # STEP 1 - Read in information and get traing and testing stations
427
  ############# 
428
  
429
  date<-strptime(sampling_dat$date[i], "%Y%m%d")   # interpolation date being processed
430
  month<-strftime(date, "%m")          # current month of the date being processed
431
  LST_month<-paste("mm_",month,sep="") # name of LST month to be matched
432
  proj_str<-proj4string(dst) #get the local projection information from monthly data
433

    
434
  ###Regression part 1: Creating a validation dataset by creating training and testing datasets
435
  data_day<-ghcn.subsets[[i]]
436
  mod_LST <- ghcn.subsets[[i]][,match(LST_month, names(ghcn.subsets[[i]]))]  #Match interpolation date and monthly LST average
437
  data_day$LST <- as.data.frame(mod_LST)[,1] #Add the variable LST to the dataset
438
  dst$LST<-dst[[LST_month]] #Add the variable LST to the monthly dataset
439
  
440
  ind.training<-sampling[[i]]
441
  ind.testing <- setdiff(1:nrow(data_day), ind.training)
442
  data_s <- data_day[ind.training, ]   #Training dataset currently used in the modeling
443
  data_v <- data_day[ind.testing, ]    #Testing/validation dataset using input sampling
444
  
445
  ns<-nrow(data_s)
446
  nv<-nrow(data_v)
447
  #i=1
448
  date_proc<-sampling_dat$date[i]
449
  date_proc<-strptime(sampling_dat$date[i], "%Y%m%d")   # interpolation date being processed
450
  mo<-as.integer(strftime(date_proc, "%m"))          # current month of the date being processed
451
  day<-as.integer(strftime(date_proc, "%d"))
452
  year<-as.integer(strftime(date_proc, "%Y"))
453
  
454
  ##########
455
  # STEP 2 - JOIN DAILY AND MONTHLY STATION INFORMATION
456
  ##########
457
  
458
  modst<-dst[dst$month==mo,] #Subsetting dataset for the relevant month of the date being processed
459

    
460
  if (var=="TMIN"){
461
    modst$LSTD_bias <- modst$LST-modst$TMin; #That is the difference between the monthly LST mean and monthly station mean
462
  }
463
  if (var=="TMAX"){
464
    modst$LSTD_bias <- modst$LST-modst$TMax; #That is the difference between the monthly LST mean and monthly station mean    
465
  }
466
  #This may be unnecessary since LSTD_bias is already in dst?? check the info
467
  #Some loss of observations: LSTD_bias for January has only 56 out of 66 possible TMIN!!! We may need to look into this issue
468
  #to avoid some losses of station data...
469
  
470
  #Clearn out this part: make this a function call
471
  x<-as.data.frame(data_v)
472
  d<-as.data.frame(data_s)
473
  for (j in 1:nrow(x)){
474
    if (x$value[j]== -999.9){
475
      x$value[j]<-NA
476
    }
477
  }
478
  for (j in 1:nrow(d)){
479
    if (d$value[j]== -999.9){
480
      d$value[j]<-NA
481
    }
482
  }
483
  pos<-match("value",names(d)) #Find column with name "value"
484
  #names(d)[pos]<-c("dailyTmax")
485
  names(d)[pos]<-y_var_name
486
  pos<-match("value",names(x)) #Find column with name "value"
487
  names(x)[pos]<-y_var_name
488
  pos<-match("station",names(d)) #Find column with station ID
489
  names(d)[pos]<-c("id")
490
  pos<-match("station",names(x)) #Find column with name station ID
491
  names(x)[pos]<-c("id")
492
  pos<-match("station",names(modst)) #Find column with name station ID
493
  names(modst)[pos]<-c("id")       #modst contains the average tmax per month for every stations...
494
  
495
  dmoday <-merge(modst,d,by="id",suffixes=c("",".y2"))  
496
  xmoday <-merge(modst,x,by="id",suffixes=c("",".y2"))  
497
  mod_pat<-glob2rx("*.y2")   #remove duplicate columns that have ".y2" in their names
498
  var_pat<-grep(mod_pat,names(dmoday),value=FALSE) # using grep with "value" extracts the matching names
499
  dmoday<-dmoday[,-var_pat] #dropping relevant columns
500
  mod_pat<-glob2rx("*.y2")   
501
  var_pat<-grep(mod_pat,names(xmoday),value=FALSE) # using grep with "value" extracts the matching names
502
  xmoday<-xmoday[,-var_pat] #Removing duplicate columns
503
  
504
  data_v<-xmoday
505
  
506
  #dmoday contains the daily tmax values for training with TMax/TMin being the monthly station tmax/tmin mean
507
  #xmoday contains the daily tmax values for validation with TMax/TMin being the monthly station tmax/tmin mean
508
  
509
  ##########
510
  # STEP 3 - interpolate daily delta across space
511
  ##########
512
  
513
  #Change to take into account TMin and TMax
514
  if (var=="TMIN"){
515
    daily_delta<-dmoday$dailyTmin-dmoday$TMin #daily detl is the difference between monthly and daily temperatures
516
  }
517
  if (var=="TMAX"){
518
    daily_delta<-dmoday$dailyTmax-dmoday$TMax
519
  }
520

    
521
  daily_delta_xy<-as.matrix(cbind(dmoday$x,dmoday$y))
522
  fitdelta<-Krig(daily_delta_xy,daily_delta,theta=1e5) #use TPS or krige
523
  mod_krtmp2<-fitdelta
524
  model_name<-paste("mod_kr","day",sep="_")
525
  data_s<-dmoday #put the 
526
  data_s$daily_delta<-daily_delta
527
  
528
  #########
529
  # STEP 4 - Calculate daily predictions - T(day) = clim(month) + delta(day)
530
  #########
531
  
532
  rast_clim_list<-rast_clim_yearlist[[mo]]  #select relevant month
533
  rast_clim_month<-raster(rast_clim_list[[1]])
534
  
535
  daily_delta_rast<-interpolate(rast_clim_month,fitdelta) #Interpolation of the bias surface...
536
  
537
  #Saving kriged surface in raster images
538
  data_name<-paste("daily_delta_",y_var_name,"_",sampling_dat$date[i],"_",sampling_dat$prop[i],
539
                   "_",sampling_dat$run_samp[i],sep="")
540
  raster_name_delta<-file.path(out_path,paste(interpolation_method,"_",var,"_",data_name,out_prefix,".tif", sep=""))
541
  writeRaster(daily_delta_rast, filename=raster_name_delta,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
542
  
543
  #Now predict daily after having selected the relevant month
544
  temp_list<-vector("list",length(rast_clim_list))  
545
  for (j in 1:length(rast_clim_list)){
546
    rast_clim_month<-raster(rast_clim_list[[j]])
547
    temp_predicted<-rast_clim_month+daily_delta_rast
548
    
549
    data_name<-paste(y_var_name,"_predicted_",names(rast_clim_list)[j],"_",
550
                     sampling_dat$date[i],"_",sampling_dat$prop[i],
551
                     "_",sampling_dat$run_samp[i],sep="")
552
    raster_name<-file.path(out_path,paste(interpolation_method,"_",data_name,out_prefix,".tif", sep=""))
553
    writeRaster(temp_predicted, filename=raster_name,overwrite=TRUE) 
554
    temp_list[[j]]<-raster_name
555
  }
556
  
557
  ##########
558
  # STEP 5 - Prepare output object to return
559
  ##########
560
  
561
  mod_krtmp2<-fitdelta
562
  model_name<-paste("mod_kr","day",sep="_")
563
  names(temp_list)<-names(rast_clim_list)
564
  coordinates(data_s)<-cbind(data_s$x,data_s$y)
565
  proj4string(data_s)<-proj_str
566
  coordinates(data_v)<-cbind(data_v$x,data_v$y)
567
  proj4string(data_v)<-proj_str
568
  
569
  delta_obj<-list(temp_list,rast_clim_list,raster_name_delta,data_s,
570
                  data_v,sampling_dat[i,],mod_krtmp2)
571
  
572
  obj_names<-c(y_var_name,"clim","delta","data_s","data_v",
573
               "sampling_dat",model_name)
574
  names(delta_obj)<-obj_names 
575
  save(delta_obj,file= file.path(out_path,paste("delta_obj_",var,"_",sampling_dat$date[i],"_",sampling_dat$prop[i],
576
                                "_",sampling_dat$run_samp[i],out_prefix,".RData",sep="")))
577
  return(delta_obj)
578
  
579
}
580
 
(12-12/52)