Project

General

Profile

« Previous | Next » 

Revision 230a3ae4

Added by Benoit Parmentier over 11 years ago

interpolation day script, adding GAM daily prediciction method

View differences:

climate/research/oregon/interpolation/interpolation_method_day_function_multisampling.R
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: 06/03/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
predict_auto_krige_raster_model<-function(list_formulas,r_stack,out_filename){
61
  #This functions performs predictions on a raster grid given input models.
62
  #Arguments: list of fitted models, raster stack of covariates
63
  #Output: spatial grid data frame of the subset of tiles
64
  
65
  list_fitted_models<-vector("list",length(list_formulas))
66
  for (k in 1:length(list_formulas)){
67
    formula<-list_formulas[[k]]
68
    mod<- try(gam(formula, data=data_training)) #change to any model!!
69
    #mod<- try(autoKrige(formula, input_data=data_s,new_data=s_sgdf,data_variogram=data_s))
70
    model_name<-paste("mod",k,sep="")
71
    assign(model_name,mod) 
72
    list_fitted_models[[k]]<-mod
73
  }
74
  return(list_fitted_models) 
75
  
76
  list_rast_pred<-vector("list",length(in_models))
77
  for (i in 1:length(in_models)){
78
    mod <-in_models[[i]] #accessing GAM model ojbect "j"
79
    raster_name<-out_filename[[i]]
80
    if (inherits(mod,"gam")) {           #change to c("gam","autoKrige")
81
      raster_pred<- predict(object=r_stack,model=mod,na.rm=FALSE) #Using the coeff to predict new values.
82
      names(raster_pred)<-"y_pred"  
83
      writeRaster(raster_pred, filename=raster_name,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
84
      #print(paste("Interpolation:","mod", j ,sep=" "))
85
      list_rast_pred[[i]]<-raster_name
86
    }
87
  }
88
  if (inherits(mod,"try-error")) {
89
    print(paste("no gam model fitted:",mod[1],sep=" ")) #change message for any model type...
90
  }
91
  return(list_rast_pred)
92
}
93

  
94
fit_models<-function(list_formulas,data_training){
95
  #This functions several models and returns model objects.
96
  #Arguments: - list of formulas for GAM models
97
  #           - fitting data in a data.frame or SpatialPointDataFrame
98
  #Output: list of model objects 
99
  list_fitted_models<-vector("list",length(list_formulas))
100
  for (k in 1:length(list_formulas)){
101
    formula<-list_formulas[[k]]
102
    mod<- try(gam(formula, data=data_training)) #change to any model!!
103
    #mod<- try(autoKrige(formula, input_data=data_s,new_data=s_sgdf,data_variogram=data_s))
104
    model_name<-paste("mod",k,sep="")
105
    assign(model_name,mod) 
106
    list_fitted_models[[k]]<-mod
107
  }
108
  return(list_fitted_models) 
109
}
110

  
111
####
112
#TODO:
113
#Add log file and calculate time and sizes for processes-outputs
114
runGAM_day_fun <-function(i,list_param){
115

  
116
  #Make this a function with multiple argument that can be used by mcmapply??
117
  #Arguments: 
118
  #1)list_index: j 
119
  #2)covar_rast: covariates raster images used in the modeling
120
  #3)covar_names: names of input variables 
121
  #4)lst_avg: list of LST climatogy names, may be removed later on
122
  #5)list_models: list input models for bias calculation
123
  #6)sampling_obj: data at the daily time scale
124
  #7)var: TMAX or TMIN, variable being interpolated
125
  #8)y_var_name: output name, not used at this stage
126
  #9)out_prefix
127
  #10) out_path
128
  
129
  #The output is a list of four shapefile names produced by the function:
130
  #1) clim: list of output names for raster climatogies 
131
  #2) data_month: monthly training data for bias surface modeling
132
  #3) mod: list of model objects fitted 
133
  #4) formulas: list of formulas used in bias modeling
134
    
135
  ### PARSING INPUT ARGUMENTS
136
  #list_param_runGAMFusion<-list(i,clim_yearlist,sampling_obj,var,y_var_name, out_prefix)
137
    
138
  index<-list_param$list_index
139
  s_raster<-list_param$covar_rast
140
  covar_names<-list_param$covar_names
141
  lst_avg<-list_param$lst_avg
142
  list_models<-list_param$list_models
143
  dst<-list_param$dst #monthly station dataset
144
  sampling_obj<-list_param$sampling_obj
145
  var<-list_param$var
146
  y_var_name<-list_param$y_var_name
147
  interpolation_method <-list_param$interpolation_method
148
  out_prefix<-list_param$out_prefix
149
  out_path<-list_param$out_path
150
  
151

  
152
  ghcn.subsets<-sampling_obj$ghcn_data_day
153
  sampling_dat <- sampling_obj$sampling_dat
154
  sampling <- sampling_obj$sampling_index
155
    
156
  ##########
157
  # STEP 1 - Read in information and get traing and testing stations
158
  ############# 
159
  
160
  date<-strptime(sampling_dat$date[i], "%Y%m%d")   # interpolation date being processed
161
  month<-strftime(date, "%m")          # current month of the date being processed
162
  LST_month<-paste("mm_",month,sep="") # name of LST month to be matched
163
  proj_str<-proj4string(dst) #get the local projection information from monthly data
164
  
165
  #Adding layer LST to the raster stack  
166
  #names(s_raster)<-covar_names
167
  pos<-match("LST",names(s_raster)) #Find the position of the layer with name "LST", if not present pos=NA
168
  s_raster<-dropLayer(s_raster,pos)      # If it exists drop layer
169
  LST<-subset(s_raster,LST_month)
170
  names(LST)<-"LST"
171
  s_raster<-addLayer(s_raster,LST)            #Adding current month
172
  
173
  ###Regression part 1: Creating a validation dataset by creating training and testing datasets
174
  data_day<-ghcn.subsets[[i]]
175
  mod_LST <- ghcn.subsets[[i]][,match(LST_month, names(ghcn.subsets[[i]]))]  #Match interpolation date and monthly LST average
176
  data_day$LST <- as.data.frame(mod_LST)[,1] #Add the variable LST to the daily dataset
177
  dst$LST<-dst[[LST_month]] #Add the variable LST to the monthly dataset
178
  
179
  ind.training<-sampling[[i]]
180
  ind.testing <- setdiff(1:nrow(data_day), ind.training)
181
  data_s <- data_day[ind.training, ]   #Training dataset currently used in the modeling
182
  data_v <- data_day[ind.testing, ]    #Testing/validation dataset using input sampling
183
  
184
  ns<-nrow(data_s)
185
  nv<-nrow(data_v)
186
  #i=1
187
  date_proc<-sampling_dat$date[i]
188
  date_proc<-strptime(sampling_dat$date[i], "%Y%m%d")   # interpolation date being processed
189
  mo<-as.integer(strftime(date_proc, "%m"))          # current month of the date being processed
190
  day<-as.integer(strftime(date_proc, "%d"))
191
  year<-as.integer(strftime(date_proc, "%Y"))
192
  
193
  #### STEP 2: PREPARE DATA
194
    
195
  #Clean out this part: make this a function call
196
  x<-as.data.frame(data_v)
197
  d<-as.data.frame(data_s)
198
  for (j in 1:nrow(x)){
199
    if (x$value[j]== -999.9){
200
      x$value[j]<-NA
201
    }
202
  }
203
  for (j in 1:nrow(d)){
204
    if (d$value[j]== -999.9){
205
      d$value[j]<-NA
206
    }
207
  }
208
  pos<-match("value",names(d)) #Find column with name "value"
209
  names(d)[pos]<-y_var_name
210
  pos<-match("value",names(x)) #Find column with name "value"
211
  names(x)[pos]<-y_var_name
212
  pos<-match("station",names(d)) #Find column with station ID
213
  names(d)[pos]<-c("id")
214
  pos<-match("station",names(x)) #Find column with name station ID
215
  names(x)[pos]<-c("id")
216
  
217
  data_s<-d
218
  data_v<-x
219

  
220
  data_s$y_var <- data_s[[y_var_name]] #Adding the variable modeled
221
  data_v$y_var <- data_v[[y_var_name]]
222
  
223
  #Adding back spatal definition
224
  
225
  coordinates(data_s)<-cbind(data_s$x,data_s$y)
226
  proj4string(data_s)<-proj_str
227
  coordinates(data_v)<-cbind(data_v$x,data_v$y)
228
  proj4string(data_v)<-proj_str
229
  #### STEP3:  NOW FIT AND PREDICT  MODEL
230
  
231
  list_formulas<-lapply(list_models,as.formula,env=.GlobalEnv) #mulitple arguments passed to lapply!!
232
  
233
  mod_list<-fit_models(list_formulas,data_s) #only gam at this stage
234
  cname<-paste("mod",1:length(mod_list),sep="") #change to more meaningful name?
235
  names(mod_list)<-cname
236
  
237
  #Now generate file names for the predictions...
238
  list_out_filename<-vector("list",length(mod_list))
239
  names(list_out_filename)<-cname  
240
  
241
  for (k in 1:length(list_out_filename)){
242
    #i indicate which day is predicted, y_var_name indicates TMIN or TMAX
243
    data_name<-paste(y_var_name,"_predicted_",names(mod_list)[k],"_",
244
                     sampling_dat$date[i],"_",sampling_dat$prop[i],
245
                     "_",sampling_dat$run_samp[i],sep="")
246
    raster_name<-file.path(out_path,paste(interpolation_method,"_",data_name,out_prefix,".tif", sep=""))
247
    list_out_filename[[k]]<-raster_name 
248
  }
249
  
250
  #now predict values for raster image...
251
  rast_day_list<-predict_raster_model(mod_list,s_raster,list_out_filename)
252
  names(rast_day_list)<-cname
253
  #Some models will not be predicted...remove them
254
  rast_day_list<-rast_day_list[!sapply(rast_day_list,is.null)] #remove NULL elements in list
255
    
256
  #Prepare object to return
257
  
258
  day_obj<- list(rast_day_list,data_s,data_v,sampling_dat[i,],mod_list,list_models)
259
  obj_names<-c(y_var_name,"data_s","data_v","sampling_dat","mod","formulas")
260
  names(day_obj)<-obj_names 
261
  save(day_obj,file= file.path(out_path,paste("day_obj_",interpolation_method,"_",var,"_",sampling_dat$date[i],"_",sampling_dat$prop[i],
262
                                                "_",sampling_dat$run_samp[i],out_prefix,".RData",sep="")))
263
  return(day_obj)
264
  
265
}
266

  
267

  
268
runClim_KGFusion<-function(j,list_param){
269
  
270
  #Make this a function with multiple argument that can be used by mcmapply??
271
  #Arguments: 
272
  #1)list_index: j 
273
  #2)covar_rast: covariates raster images used in the modeling
274
  #3)covar_names: names of input variables 
275
  #4)lst_avg: list of LST climatogy names, may be removed later on
276
  #5)list_models: list input models for bias calculation
277
  #6)dst: data at the monthly time scale
278
  #7)var: TMAX or TMIN, variable being interpolated
279
  #8)y_var_name: output name, not used at this stage
280
  #9)out_prefix
281
  #
282
  #The output is a list of four shapefile names produced by the function:
283
  #1) clim: list of output names for raster climatogies 
284
  #2) data_month: monthly training data for bias surface modeling
285
  #3) mod: list of model objects fitted 
286
  #4) formulas: list of formulas used in bias modeling
287
  
288
  ### PARSING INPUT ARGUMENTS
289
  #list_param_runGAMFusion<-list(i,clim_yearlist,sampling_obj,var,y_var_name, out_prefix)
290
  
291
  index<-list_param$j
292
  s_raster<-list_param$covar_rast
293
  covar_names<-list_param$covar_names
294
  lst_avg<-list_param$lst_avg
295
  list_models<-list_param$list_models
296
  dst<-list_param$dst #monthly station dataset
297
  var<-list_param$var
298
  y_var_name<-list_param$y_var_name
299
  out_prefix<-list_param$out_prefix
300
  out_path<-list_param$out_path
301
  
302
  #Model and response variable can be changed without affecting the script
303
  prop_month<-0 #proportion retained for validation
304
  run_samp<-1 #This option can be added later on if/when neeeded
305
  
306
  #### STEP 2: PREPARE DATA
307
  
308
  data_month<-dst[dst$month==j,] #Subsetting dataset for the relevant month of the date being processed
309
  LST_name<-lst_avg[j] # name of LST month to be matched
310
  data_month$LST<-data_month[[LST_name]]
311
  
312
  #Adding layer LST to the raster stack  
313
  covar_rast<-s_raster
314
  #names(s_raster)<-covar_names
315
  pos<-match("LST",names(s_raster)) #Find the position of the layer with name "LST", if not present pos=NA
316
  s_raster<-dropLayer(s_raster,pos)      # If it exists drop layer
317
  LST<-subset(s_raster,LST_name)
318
  names(LST)<-"LST"
319
  s_raster<-addLayer(s_raster,LST)            #Adding current month
320
  
321
  #LST bias to model...
322
  if (var=="TMAX"){
323
    data_month$LSTD_bias<-data_month$LST-data_month$TMax
324
    data_month$y_var<-data_month$LSTD_bias #Adding bias as the variable modeled
325
  }
326
  if (var=="TMIN"){
327
    data_month$LSTD_bias<-data_month$LST-data_month$TMin
328
    data_month$y_var<-data_month$LSTD_bias #Adding bias as the variable modeled
329
  }
330
  
331
  #### STEP3:  NOW FIT AND PREDICT  MODEL
332
  
333
  list_formulas<-lapply(list_models,as.formula,env=.GlobalEnv) #mulitple arguments passed to lapply!!
334
  
335
  mod_list<-fit_models(list_formulas,data_month) #only gam at this stage
336
  cname<-paste("mod",1:length(mod_list),sep="") #change to more meaningful name?
337
  names(mod_list)<-cname
338
  
339
  #Now generate file names for the predictions...
340
  list_out_filename<-vector("list",length(mod_list))
341
  names(list_out_filename)<-cname  
342
  
343
  for (k in 1:length(list_out_filename)){
344
    #j indicate which month is predicted, var indicates TMIN or TMAX
345
    data_name<-paste(var,"_bias_LST_month_",j,"_",cname[k],"_",prop_month,
346
                     "_",run_samp,sep="")
347
    raster_name<-file.path(out_path,paste("fusion_",data_name,out_prefix,".tif", sep=""))
348
    list_out_filename[[k]]<-raster_name
349
  }
350

  
351
  #now predict values for raster image...
352
  rast_bias_list<-predict_raster_model(mod_list,s_raster,list_out_filename)
353
  names(rast_bias_list)<-cname
354
  #Some modles will not be predicted...remove them
355
  rast_bias_list<-rast_bias_list[!sapply(rast_bias_list,is.null)] #remove NULL elements in list
356

  
357
  mod_rast<-stack(rast_bias_list)  #stack of bias raster images from models
358
  rast_clim_list<-vector("list",nlayers(mod_rast))
359
  names(rast_clim_list)<-names(rast_bias_list)
360
  for (k in 1:nlayers(mod_rast)){
361
    clim_fus_rast<-LST-subset(mod_rast,k)
362
    data_name<-paste(var,"_clim_LST_month_",j,"_",names(rast_clim_list)[k],"_",prop_month,
363
                     "_",run_samp,sep="")
364
    raster_name<-file.path(out_path,paste("fusion_",data_name,out_prefix,".tif", sep=""))
365
    rast_clim_list[[k]]<-raster_name
366
    writeRaster(clim_fus_rast, filename=raster_name,overwrite=TRUE)  #Wri
367
  }
368
  
369
  #### STEP 4:Adding Kriging for Climatology options
370
  
371
  bias_xy<-coordinates(data_month)
372
  fitbias<-Krig(bias_xy,data_month$LSTD_bias,theta=1e5) #use TPS or krige 
373
  mod_krtmp1<-fitbias
374
  model_name<-"mod_kr"
375
  
376
   
377
  bias_rast<-interpolate(LST,fitbias) #interpolation using function from raster package
378
  #Saving kriged surface in raster images
379
  data_name<-paste(var,"_bias_LST_month_",j,"_",model_name,"_",prop_month,
380
                   "_",run_samp,sep="")
381
  raster_name_bias<-file.path(out_path,paste("fusion_",data_name,out_prefix,".tif", sep=""))
382
  writeRaster(bias_rast, filename=raster_name_bias,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
383
  
384
  #now climatology layer
385
  clim_rast<-LST-bias_rast
386
  data_name<-paste(var,"_clim_LST_month_",j,"_",model_name,"_",prop_month,
387
                   "_",run_samp,sep="")
388
  raster_name_clim<-file.path(out_path,paste("fusion_",data_name,out_prefix,".tif", sep=""))
389
  writeRaster(clim_rast, filename=raster_name_clim,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
390
  
391
  #Adding to current objects
392
  mod_list[[model_name]]<-mod_krtmp1
393
  rast_bias_list[[model_name]]<-raster_name_bias
394
  rast_clim_list[[model_name]]<-raster_name_clim
395
  
396
  #### STEP 5: Prepare object and return
397
  
398
  clim_obj<-list(rast_bias_list,rast_clim_list,data_month,mod_list,list_formulas)
399
  names(clim_obj)<-c("bias","clim","data_month","mod","formulas")
400
  
401
  save(clim_obj,file= file.path(out_path,paste("clim_obj_month_",j,"_",var,"_",out_prefix,".RData",sep="")))
402
  
403
  return(clim_obj)
404
}
405

  
406
## Run function for kriging...?
407

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

  
456
  ###Regression part 1: Creating a validation dataset by creating training and testing datasets
457
  data_day<-ghcn.subsets[[i]]
458
  mod_LST <- ghcn.subsets[[i]][,match(LST_month, names(ghcn.subsets[[i]]))]  #Match interpolation date and monthly LST average
459
  data_day$LST <- as.data.frame(mod_LST)[,1] #Add the variable LST to the dataset
460
  dst$LST<-dst[[LST_month]] #Add the variable LST to the monthly dataset
461
  
462
  ind.training<-sampling[[i]]
463
  ind.testing <- setdiff(1:nrow(data_day), ind.training)
464
  data_s <- data_day[ind.training, ]   #Training dataset currently used in the modeling
465
  data_v <- data_day[ind.testing, ]    #Testing/validation dataset using input sampling
466
  
467
  ns<-nrow(data_s)
468
  nv<-nrow(data_v)
469
  #i=1
470
  date_proc<-sampling_dat$date[i]
471
  date_proc<-strptime(sampling_dat$date[i], "%Y%m%d")   # interpolation date being processed
472
  mo<-as.integer(strftime(date_proc, "%m"))          # current month of the date being processed
473
  day<-as.integer(strftime(date_proc, "%d"))
474
  year<-as.integer(strftime(date_proc, "%Y"))
475
  
476
  ##########
477
  # STEP 2 - JOIN DAILY AND MONTHLY STATION INFORMATION
478
  ##########
479
  
480
  modst<-dst[dst$month==mo,] #Subsetting dataset for the relevant month of the date being processed
481

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

  
543
  daily_delta_xy<-as.matrix(cbind(dmoday$x,dmoday$y))
544
  fitdelta<-Krig(daily_delta_xy,daily_delta,theta=1e5) #use TPS or krige
545
  mod_krtmp2<-fitdelta
546
  model_name<-paste("mod_kr","day",sep="_")
547
  data_s<-dmoday #put the 
548
  data_s$daily_delta<-daily_delta
549
  
550
  #########
551
  # STEP 4 - Calculate daily predictions - T(day) = clim(month) + delta(day)
552
  #########
553
  
554
  rast_clim_list<-rast_clim_yearlist[[mo]]  #select relevant month
555
  rast_clim_month<-raster(rast_clim_list[[1]])
556
  
557
  daily_delta_rast<-interpolate(rast_clim_month,fitdelta) #Interpolation of the bias surface...
558
  
559
  #Saving kriged surface in raster images
560
  data_name<-paste("daily_delta_",y_var_name,"_",sampling_dat$date[i],"_",sampling_dat$prop[i],
561
                   "_",sampling_dat$run_samp[i],sep="")
562
  raster_name_delta<-file.path(out_path,paste(interpolation_method,"_",var,"_",data_name,out_prefix,".tif", sep=""))
563
  writeRaster(daily_delta_rast, filename=raster_name_delta,overwrite=TRUE)  #Writing the data in a raster file format...(IDRISI)
564
  
565
  #Now predict daily after having selected the relevant month
566
  temp_list<-vector("list",length(rast_clim_list))  
567
  for (j in 1:length(rast_clim_list)){
568
    rast_clim_month<-raster(rast_clim_list[[j]])
569
    temp_predicted<-rast_clim_month+daily_delta_rast
570
    
571
    data_name<-paste(y_var_name,"_predicted_",names(rast_clim_list)[j],"_",
572
                     sampling_dat$date[i],"_",sampling_dat$prop[i],
573
                     "_",sampling_dat$run_samp[i],sep="")
574
    raster_name<-file.path(out_path,paste(interpolation_method,"_",data_name,out_prefix,".tif", sep=""))
575
    writeRaster(temp_predicted, filename=raster_name,overwrite=TRUE) 
576
    temp_list[[j]]<-raster_name
577
  }
578
  
579
  ##########
580
  # STEP 5 - Prepare output object to return
581
  ##########
582
  
583
  mod_krtmp2<-fitdelta
584
  model_name<-paste("mod_kr","day",sep="_")
585
  names(temp_list)<-names(rast_clim_list)
586
  coordinates(data_s)<-cbind(data_s$x,data_s$y)
587
  proj4string(data_s)<-proj_str
588
  coordinates(data_v)<-cbind(data_v$x,data_v$y)
589
  proj4string(data_v)<-proj_str
590
  
591
  delta_obj<-list(temp_list,rast_clim_list,raster_name_delta,data_s,
592
                  data_v,sampling_dat[i,],mod_krtmp2)
593
  
594
  obj_names<-c(y_var_name,"clim","delta","data_s","data_v",
595
               "sampling_dat",model_name)
596
  names(delta_obj)<-obj_names 
597
  save(delta_obj,file= file.path(out_path,paste("delta_obj_",var,"_",sampling_dat$date[i],"_",sampling_dat$prop[i],
598
                                "_",sampling_dat$run_samp[i],out_prefix,".RData",sep="")))
599
  return(delta_obj)
600
  
601
}
602
 
climate/research/oregon/interpolation/master_script_temp.R
10 10
#STAGE 5: Output analyses: assessment of results for specific dates...
11 11
#
12 12
#AUTHOR: Benoit Parmentier                                                                       
13
#DATE: 05/31/2013                                                                                 
13
#DATE: 06/03/2013                                                                                 
14 14

  
15 15
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#363, TASK$568--   
16 16

  
......
48 48

  
49 49
##SCRIPT USED FOR THE PREDICTIONS: Source or list all scripts here to avoid confusion on versions being run!!!!
50 50

  
51
#source(file.path(script_path,"master_script_temp_05272013.R")) #Master script can be run directly...
51
#source(file.path(script_path,"master_script_temp_06032013.R")) #Master script can be run directly...
52 52

  
53 53
#CALLED FROM MASTER SCRIPT:
54 54

  
......
58 58
source(file.path(script_path,"download_and_produce_MODIS_LST_climatology_05302013.R"))
59 59
source(file.path(script_path,"covariates_production_temperatures_05302013.R"))
60 60
source(file.path(script_path,"Database_stations_covariates_processing_function_05212013.R"))
61
source(file.path(script_path,"GAM_fusion_analysis_raster_prediction_multisampling_05212013.R"))
61
source(file.path(script_path,"GAM_fusion_analysis_raster_prediction_multisampling_06032013.R"))
62 62
source(file.path(script_path,"results_interpolation_date_output_analyses_05062013.R"))
63 63
#source(file.path(script_path,"results_covariates_database_stations_output_analyses_04012013.R"))
64 64

  
......
66 66

  
67 67
source(file.path(script_path,"sampling_script_functions_03122013.R"))
68 68
source(file.path(script_path,"GAM_fusion_function_multisampling_05212013.R")) #Include GAM_CAI
69
source(file.path(script_path,"interpolation_method_day_function_multisampling_06032013.R")) #Include GAM_day
69 70
source(file.path(script_path,"GAM_fusion_function_multisampling_validation_metrics_05062013.R"))
70 71

  
71 72
#stages_to_run<-c(1,2,3,4,5) #May decide on antoher strategy later on...
72 73
stages_to_run<-c(0,2,3,4,5) #May decide on antoher strategy later on...
73 74

  
74 75
var<-"TMAX" # variable being interpolated
75
out_prefix<-"_365d_GAM_fus_all_lst_05312013"                #User defined output prefix
76
out_suffix<-"_OR_05312013"
76
out_prefix<-"_365d_GAM_fus_all_lst_06032013"                #User defined output prefix
77
out_suffix<-"_OR_06032013"
77 78
out_suffix_modis <-"_05302013" #use tiles produce previously
78 79

  
79
#interpolation_method<-c("gam_fusion","gam_CAI") #other otpions to be added later
80
#interpolation_method<-c("gam_fusion","gam_CAI","gam_daily") #other otpions to be added later
80 81
#interpolation_method<-c("gam_CAI") #other otpions to be added later
81
interpolation_method<-c("gam_fusion") #other otpions to be added later
82
#interpolation_method<-c("gam_fusion") #other otpions to be added later
83
interpolation_method<-c("gam_daily") #other otpions to be added later
82 84

  
83 85
#out_path <- paste("/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/output_data",
84 86
#                  out_prefix,"/",sep="")

Also available in: Unified diff