Project

General

Profile

Download (14.8 KB) Statistics
| Branch: | Revision:
1
#########################    Raster prediction GAM FUSION    ####################################
2
############################ Interpolation of temperature for given processing region ##########################################
3
#This script interpolates temperature values using MODIS LST, covariates and GHCND station data.                      
4
#It requires the text file of stations and a shape file of the study area.           
5
#Note that the projection for both GHCND and study area is lonlat WGS84.       
6
#Options to run this program are:
7
#1) Multisampling: vary the porportions of hold out and use random samples for each run
8
#2)Constant sampling: use the same sample over the runs
9
#3)over dates: run over for example 365 dates without mulitsampling
10
#4)use seed number: use seed if random samples must be repeatable
11
#5)GAM fusion: possibilty of running GAM+FUSION or GAM+CAI and other options added
12
#The interpolation is done first at the monthly time scale then delta surfaces are added.
13
#AUTHOR: Benoit Parmentier                                                                        
14
#DATE: 03/27/2013                                                                                 
15
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#568--     
16
#
17
# TO DO:
18
# 1) modidy to make it general for any method i.e. make call to method e.g. gam_fus, gam_cai etc.
19
# 2) simplify and bundle validation steps, make it general--method_mod_validation
20
# 3) solve issues with log file recordings
21
# 4) output location folder on the fly???
22

    
23
###################################################################################################
24

    
25
raster_prediction_gam_fusion<-function(list_param_raster_prediction){
26

    
27
  ##Function to predict temperature interpolation with 21 input parameters
28
  #9 parameters used in the data preparation stage and input in the current script
29
  #1)list_param_data_prep: used in earlier code for the query from the database and extraction for raster brick
30
  #2)infile_monthly:
31
  #3)infile_daily
32
  #4)infile_locs:
33
  #5)infile_covariates: raster covariate brick, tif file
34
  #6)covar_names: covar_names #remove at a later stage...
35
  #7)var: variable being interpolated-TMIN or TMAX
36
  #8)out_prefix
37
  #9)CRS_locs_WGS84
38
  #
39
  #6 parameters for sampling function
40
  #10)seed_number
41
  #11)nb_sample
42
  #12)step
43
  #13)constant
44
  #14)prop_minmax
45
  #15)dates_selected
46
  #
47
  #6 additional parameters for monthly climatology and more
48
  #16)list_models: model formulas in character vector
49
  #17)lst_avg: LST climatology name in the brick of covariate--change later
50
  #18)n_path
51
  #19)out_path
52
  #20)script_path: path to script
53
  #21)interpolation_method: c("gam_fusion","gam_CAI") #other otpions to be added later
54
  
55
  ###Loading R library and packages     
56
  
57
  library(gtools)                                         # loading some useful tools 
58
  library(mgcv)                                           # GAM package by Simon Wood
59
  library(sp)                                             # Spatial pacakge with class definition by Bivand et al.
60
  library(spdep)                               # Spatial pacakge with methods and spatial stat. by Bivand et al.
61
  library(rgdal)                               # GDAL wrapper for R, spatial utilities
62
  library(gstat)                               # Kriging and co-kriging by Pebesma et al.
63
  library(fields)                             # NCAR Spatial Interpolation methods such as kriging, splines
64
  library(raster)                              # Hijmans et al. package for raster processing
65
  library(rasterVis)
66
  library(parallel)                            # Urbanek S. and Ripley B., package for multi cores & parralel processing
67
  library(reshape)
68
  library(plotrix)
69
  library(maptools)
70
  library(gdata) #Nesssary to use cbindX
71
  
72
  ### Parameters and arguments
73
  #PARSING INPUTS/ARGUMENTS
74
#   
75
#   names(list_param_raster_prediction)<-c("list_param_data_prep",
76
#                                          "seed_number","nb_sample","step","constant","prop_minmax","dates_selected",
77
#                                          "list_models","lst_avg","in_path","out_path","script_path",
78
#                                          "interpolation_method")
79
  
80
  #9 parameters used in the data preparation stage and input in the current script
81
  list_param_data_prep<-list_param_raster_prediction$list_param_data_prep
82
  infile_monthly<-list_param_data_prep$infile_monthly
83
  infile_daily<-list_param_data_prep$infile_daily
84
  infile_locs<-list_param_data_prep$infile_locs
85
  infile_covariates<-list_param_data_prep$infile_covariates #raster covariate brick, tif file
86
  covar_names<- list_param_data_prep$covar_names #remove at a later stage...
87
  var<-list_param_data_prep$var
88
  out_prefix<-list_param_data_prep$out_prefix
89
  CRS_locs_WGS84<-list_param_data_prep$CRS_locs_WGS84
90
  
91
  #6 parameters for sampling function
92
  seed_number<-list_param_raster_prediction$seed_number
93
  nb_sample<-list_param_raster_prediction$nb_sample
94
  step<-list_param_raster_prediction$step
95
  constant<-list_param_raster_prediction$constant
96
  prop_minmax<-list_param_raster_prediction$prop_minmax
97
  dates_selected<-list_param_raster_prediction$dates_selected
98
  
99
  #6 additional parameters for monthly climatology and more
100
  list_models<-list_param_raster_prediction$list_models
101
  lst_avg<-list_param_raster_prediction$lst_avg
102
  in_path<-list_param_raster_prediction$in_path
103
  out_path<-list_param_raster_prediction$out_path
104
  script_path<-list_param_raster_prediction$script_path
105
  interpolation_method<-list_param_raster_prediction$interpolation_method
106
  
107
  setwd(in_path)
108
  
109
  #Sourcing in the master script to avoid confusion on the latest versions of scripts and functions!!!
110
  
111
  #source(file.path(script_path,"sampling_script_functions_03122013.R"))
112
  #source(file.path(script_path,"GAM_fusion_function_multisampling_03122013.R"))
113
  #source(file.path(script_path,"GAM_fusion_function_multisampling_validation_metrics_03182013.R"))
114
  
115
  
116
  ###################### START OF THE SCRIPT ########################
117
  
118
  
119
  if (var=="TMAX"){
120
    y_var_name<-"dailyTmax"                                       
121
  }
122
  if (var=="TMIN"){
123
    y_var_name<-"dailyTmin"                                       
124
  }
125
  
126
  ################# CREATE LOG FILE #####################
127
  
128
  #create log file to keep track of details such as processing times and parameters.
129
  
130
  log_fname<-paste("R_log_raster_prediction",out_prefix, ".log",sep="")
131
  
132
  if (file.exists(log_fname)){  #Stop the script???
133
    file.remove(log_fname)
134
    log_file<-file(log_fname,"w")
135
  }
136
  if (!file.exists(log_fname)){
137
    log_file<-file(log_fname,"w")
138
  }
139
  
140
  time1<-proc.time()    #Start stop watch
141
  writeLines(paste("Starting script at this local Date and Time: ",as.character(Sys.time()),sep=""),
142
             con=log_file,sep="\n")
143
  writeLines("Starting script process time:",con=log_file,sep="\n")
144
  writeLines(as.character(time1),con=log_file,sep="\n")    
145
  
146
  ############### READING INPUTS: DAILY STATION DATA AND OTEHR DATASETS  #################
147
  
148
  ghcn<-readOGR(dsn=in_path,layer=sub(".shp","",basename(infile_daily)))
149
  CRS_interp<-proj4string(ghcn)                       #Storing projection information (ellipsoid, datum,etc.)
150
  stat_loc<-readOGR(dsn=in_path,layer=sub(".shp","",basename(infile_locs)))
151
  #dates2 <-readLines(file.path(in_path,dates_selected)) #dates to be predicted, now read directly from the file
152
  if (dates_selected==""){
153
    dates<-as.character(sort(unique(ghcn$date))) #dates to be predicted 
154
  }
155
  if (dates_selected!=""){
156
    dates<-dates_selected #dates to be predicted 
157
  }
158
  
159
  #Reading of covariate brick covariates can be changed...
160
  
161
  s_raster<-brick(infile_covariates)                   #read in the data brck
162
  names(s_raster)<-covar_names               #Assigning names to the raster layers: making sure it is included in the extraction
163
  pos<-match("elev",names(s_raster))
164
  names(s_raster)[pos]<-"elev_1"
165
  
166
  #Screen for extreme values": this needs more thought, min and max val vary with regions
167
  #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)
168
  #r1[r1 < (min_val)]<-NA
169
  
170
  #Reading monthly data
171
  data3<-readOGR(dsn=in_path,layer=sub(".shp","",basename(infile_monthly)))
172
  dst_all<-data3
173
  dst<-data3
174
  
175
  ### TO DO -important ###
176
  #Cleaning/sceerniging functions for daily stations, monthly stations and covariates?? do this during the preparation stage!!!??
177
  ###
178
  
179
  ########### CREATE SAMPLING -TRAINING AND TESTING STATIONS ###########
180
  
181
  #Input for sampling function...
182
  
183
  #dates #list of dates for prediction
184
  #ghcn_name<-"ghcn" #infile daily data 
185
  
186
  list_param_sampling<-list(seed_number,nb_sample,step,constant,prop_minmax,dates,ghcn)
187
  #list_param_sampling<-list(seed_number,nb_sample,step,constant,prop_minmax,dates,ghcn_name)
188
  names(list_param_sampling)<-c("seed_number","nb_sample","step","constant","prop_minmax","dates","ghcn")
189
  
190
  #run function, note that dates must be a character vector!!
191
  sampling_obj<-sampling_training_testing(list_param_sampling)
192
  
193
  ########### PREDICT FOR MONTHLY SCALE  ##################
194
  
195
  #First predict at the monthly time scale: climatology
196
  writeLines("Predictions at monthly scale:",con=log_file,sep="\n")
197
  t1<-proc.time()
198
  j=12
199
  #browser()
200
  list_param_runClim_KGFusion<-list(j,s_raster,covar_names,lst_avg,list_models,dst,var,y_var_name, out_prefix)
201
  names(list_param_runClim_KGFusion)<-c("list_index","covar_rast","covar_names","lst_avg","list_models","dst","var","y_var_name","out_prefix")
202
  #source(file.path(script_path,"GAM_fusion_function_multisampling_03122013.R"))
203
  gamclim_fus_mod<-mclapply(1:12, list_param=list_param_runClim_KGFusion, runClim_KGFusion,mc.preschedule=FALSE,mc.cores = 6) #This is the end bracket from mclapply(...) statement
204
  #gamclim_fus_mod<-mclapply(1:6, runClim_KGFusion,mc.preschedule=FALSE,mc.cores = 6) #This is the end bracket from mclapply(...) statement
205
  save(gamclim_fus_mod,file= paste("gamclim_fus_mod_",y_var_name,out_prefix,".RData",sep=""))
206
  t2<-proc.time()-t1
207
  writeLines(as.character(t2),con=log_file,sep="\n")
208
  
209
  #now get list of raster clim layers
210
  
211
  list_tmp<-vector("list",length(gamclim_fus_mod))
212
  for (i in 1:length(gamclim_fus_mod)){
213
    tmp<-gamclim_fus_mod[[i]]$clim
214
    list_tmp[[i]]<-tmp
215
  }
216
  
217
  ################## PREDICT AT DAILY TIME SCALE #################
218
  
219
  #put together list of clim models per month...
220
  #rast_clim_yearlist<-list_tmp
221
  clim_yearlist<-list_tmp
222
  #Second predict at the daily time scale: delta
223
  
224
  #gam_fus_mod<-mclapply(1:1, runGAMFusion,mc.preschedule=FALSE,mc.cores = 1) #This is the end bracket from mclapply(...) statement
225
  writeLines("Predictions at the daily scale:",con=log_file,sep="\n")
226
  t1<-proc.time()
227
  
228
  #input a list:note that ghcn.subsets is not sampling_obj$data_day_ghcn
229
  list_param_runGAMFusion<-list(i,clim_yearlist,sampling_obj,dst,var,y_var_name, out_prefix)
230
  names(list_param_runGAMFusion)<-c("list_index","clim_yearlist","sampling_obj","dst","var","y_var_name","out_prefix")
231
  #test<-mclapply(1:18, runGAMFusion,list_param=list_param_runGAMFusion,mc.preschedule=FALSE,mc.cores = 9)
232
  
233
  #MAKE IT GENERAL: for any method
234
  
235
  gam_fus_mod<-mclapply(1:length(sampling_obj$ghcn_data_day),list_param=list_param_runGAMFusion,runGAMFusion,mc.preschedule=FALSE,mc.cores = 9) #This is the end bracket from mclapply(...) statement
236
  
237
  #gam_fus_mod<-mclapply(1:length(sampling_obj$ghcn_data_day),runGAMFusion,list_param_runGAMFusion,mc.preschedule=FALSE,mc.cores = 9) #This is the end bracket from mclapply(...) statement
238
  #gam_fus_mod<-mclapply(1:length(ghcn.subsets), runGAMFusion,mc.preschedule=FALSE,mc.cores = 9) #This is the end bracket from mclapply(...) statement
239
  
240
  save(gam_fus_mod,file= paste("gam_fus_mod_",y_var_name,out_prefix,".RData",sep=""))
241
  t2<-proc.time()-t1
242
  writeLines(as.character(t2),con=log_file,sep="\n")
243
  #browser()
244
  
245
  ############### NOW RUN VALIDATION #########################
246
  #SIMPLIFY THIS PART: one call
247
  
248
  list_tmp<-vector("list",length(gam_fus_mod))
249
  for (i in 1:length(gam_fus_mod)){
250
    tmp<-gam_fus_mod[[i]][[y_var_name]]  #y_var_name is the variable predicted (dailyTmax or dailyTmin)
251
    list_tmp[[i]]<-tmp
252
  }
253
  rast_day_yearlist<-list_tmp #list of predicted images
254
  
255
  writeLines("Validation step:",con=log_file,sep="\n")
256
  t1<-proc.time()
257
  #calculate_accuary_metrics<-function(i)
258
  list_param_validation<-list(i,rast_day_yearlist,gam_fus_mod,y_var_name, out_prefix)
259
  names(list_param_validation)<-c("list_index","rast_day_year_list","method_mod_obj","y_var_name","out_prefix") #same names for any method
260
  
261
  #gam_fus_validation_mod<-mclapply(1:length(gam_fus_mod), calculate_accuracy_metrics,mc.preschedule=FALSE,mc.cores = 9) #This is the end bracket from mclapply(...) statement
262
  gam_fus_validation_mod<-mclapply(1:length(gam_fus_mod), list_param=list_param_validation, calculate_accuracy_metrics,mc.preschedule=FALSE,mc.cores = 9) #This is the end bracket from mclapply(...) statement
263
  
264
  #gam_fus_validation_mod<-mclapply(1:1, calculate_accuracy_metrics,mc.preschedule=FALSE,mc.cores = 1) #This is the end bracket from mclapply(...) statement
265
  save(gam_fus_validation_mod,file= paste("gam_fus_validation_mod_",y_var_name,out_prefix,".RData",sep=""))
266
  t2<-proc.time()-t1
267
  writeLines(as.character(t2),con=log_file,sep="\n")
268
  
269
  #################### ASSESSMENT OF PREDICTIONS: PLOTS OF ACCURACY METRICS ###########
270
  
271
  ##Create data.frame with valiation metrics for a full year
272
  tb_diagnostic_v<-extract_from_list_obj(gam_fus_validation_mod,"metrics_v")
273
  rownames(tb_diagnostic_v)<-NULL #remove row names
274
  
275
  #Call function to create plots of metrics for validation dataset
276
  metric_names<-c("rmse","mae","me","r","m50")
277
  summary_metrics_v<-boxplot_from_tb(tb_diagnostic_v,metric_names,out_prefix)
278
  names(summary_metrics_v)<-c("avg","median")
279
  
280
  #################### CLOSE LOG FILE  ####################
281
  
282
  #close log_file connection and add meta data
283
  writeLines("Finished script process time:",con=log_file,sep="\n")
284
  time2<-proc.time()-time1
285
  writeLines(as.character(time2),con=log_file,sep="\n")
286
  #later on add all the paramters used in the script...
287
  writeLines(paste("Finished script at this local Date and Time: ",as.character(Sys.time()),sep=""),
288
             con=log_file,sep="\n")
289
  writeLines("End of script",con=log_file,sep="\n")
290
  close(log_file)
291
  
292
  ################### PREPARE RETURN OBJECT ###############
293
  #Will add more information to be returned
294
  
295
  raster_prediction_obj<-list(gamclim_fus_mod,gam_fus_mod,gam_fus_validation_mod,tb_diagnostic_v,summary_metrics_v)
296
  names(raster_prediction_obj)<-c("gamclim_fus_mod","gam_fus_mod","gam_fus_validation_mod","tb_diagnostic_v",
297
                                  "summary_metrics_v")  
298
  save(raster_prediction_obj,file= paste("raster_prediction_obj_",y_var_name,out_prefix,".RData",sep=""))
299
  
300
  return(raster_prediction_obj)
301
}
302

    
303
####################################################################
304
######################## END OF SCRIPT/FUNCTION #####################
(10-10/41)