Project

General

Profile

Download (13.3 KB) Statistics
| Branch: | Revision:
1 972ac6af Benoit Parmentier
##################    MULTI SAMPLING GAM FUSION METHOD ASSESSMENT   ####################################
2 e7bf2d1b Benoit Parmentier
############################ Merging LST and station data ##########################################
3 fb039a6b Benoit Parmentier
#This script interpolates tmax values using MODIS LST and GHCND station data                      
4
#interpolation area. 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 1508a57e Benoit Parmentier
#5)GAM fusion: possibilty of running GAM+FUSION or GAM+CAI and other options added
12 0f602e87 Benoit Parmentier
#The interpolation is done first at the monthly time scale then delta surfaces are added.
13 fb039a6b Benoit Parmentier
#AUTHOR: Benoit Parmentier                                                                        
14 33095a53 Benoit Parmentier
#DATE: 03/05/2013                                                                                 
15 1508a57e Benoit Parmentier
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#568--                                   
16 e7bf2d1b Benoit Parmentier
###################################################################################################
17
18
###Loading R library and packages                                                      
19
library(gtools)                                         # loading some useful tools 
20
library(mgcv)                                           # GAM package by Simon Wood
21
library(sp)                                             # Spatial pacakge with class definition by Bivand et al.
22
library(spdep)                               # Spatial pacakge with methods and spatial stat. by Bivand et al.
23
library(rgdal)                               # GDAL wrapper for R, spatial utilities
24
library(gstat)                               # Kriging and co-kriging by Pebesma et al.
25 0163d0e2 Benoit Parmentier
library(fields)                             # NCAR Spatial Interpolation methods such as kriging, splines
26 e7bf2d1b Benoit Parmentier
library(raster)                              # Hijmans et al. package for raster processing
27
library(rasterVis)
28
library(parallel)                            # Urbanek S. and Ripley B., package for multi cores & parralel processing
29 fb039a6b Benoit Parmentier
library(reshape)
30
library(plotrix)
31 0f602e87 Benoit Parmentier
library(maptools)
32 c1e1cc30 Benoit Parmentier
33 33095a53 Benoit Parmentier
### Parameters and arguments
34 972ac6af Benoit Parmentier
35
## output param from previous script: Database_stations_covariates_processing_function
36 33095a53 Benoit Parmentier
#infile_monthly<-"monthly_covariates_ghcn_data_TMAXy2010_2010_VE_02082013.shp"
37
#infile_daily<-"daily_covariates_ghcn_data_TMAXy2010_2010_VE_02082013.shp"
38
#infile_locs<-"stations_venezuela_region_y2010_2010_VE_02082013.shp"
39
infile_covariates<-"covariates__venezuela_region__VE_01292013.tif" #this is an output from covariate script
40 972ac6af Benoit Parmentier
var<-"TMAX"
41
out_prefix<-"_365d_GAM_fus5_all_lstd_02202013"                #User defined output prefix
42
CRS_locs_WGS84<-CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +towgs84=0,0,0") #Station coords WGS84: same as earlier
43 e7bf2d1b Benoit Parmentier
44 33095a53 Benoit Parmentier
infile_monthly<-list_outfiles$monthly_covar_ghcn_data #outile4 from database_covar script
45
infile_daily<-list_outfiles$daily_covar_ghcn_data  #outfile3 from database_covar script
46
infile_locs<- list_outfiles$loc_stations_ghcn #outfile2? from database covar script
47
rnames <-c("x","y","lon","lat","N","E","N_w","E_w","elev","slope","aspect","CANHEIGHT","DISTOC")
48
lc_names<-c("LC1","LC2","LC3","LC4","LC5","LC6","LC7","LC8","LC9","LC10","LC11","LC12")
49
lst_names<-c("mm_01","mm_02","mm_03","mm_04","mm_05","mm_06","mm_07","mm_08","mm_09","mm_10","mm_11","mm_12",
50
             "nobs_01","nobs_02","nobs_03","nobs_04","nobs_05","nobs_06","nobs_07","nobs_08",
51
             "nobs_09","nobs_10","nobs_11","nobs_12")                  
52
covar_names<-c(rnames,lc_names,lst_names)  
53 972ac6af Benoit Parmentier
###
54
#Input for sampling function...
55 c1e1cc30 Benoit Parmentier
seed_number<- 100  #if seed zero then no seed?     
56 fb039a6b Benoit Parmentier
nb_sample<-1           #number of time random sampling must be repeated for every hold out proportion
57
step<-0         
58 0766370d Benoit Parmentier
constant<-0             #if value 1 then use the same samples as date one for the all set of dates
59 33095a53 Benoit Parmentier
prop_minmax<-c(0.3,0.3)  #if prop_min=prop_max and step=0 then predicitons are done for the number of dates...
60
infile_dates<-"list_365_dates_04212012.txt"
61 fb039a6b Benoit Parmentier
62 c1e1cc30 Benoit Parmentier
#Models to run...this can be change for each run
63
list_models<-c("y_var ~ s(elev_1)",
64
               "y_var ~ s(LST)",
65
               "y_var ~ s(elev_1,LST)",
66
               "y_var ~ s(lat) + s(lon)+ s(elev_1)",
67
               "y_var ~ s(lat,lon,elev_1)",
68
               "y_var ~ s(lat,lon) + s(elev_1) + s(N_w,E_w) + s(LST)", 
69
               "y_var ~ s(lat,lon) + s(elev_1) + s(N_w,E_w) + s(LST) + s(LC2)",
70
               "y_var ~ s(lat,lon) + s(elev_1) + s(N_w,E_w) + s(LST) + s(LC6)", 
71
               "y_var ~ s(lat,lon) + s(elev_1) + s(N_w,E_w) + s(LST) + s(DISTOC)")
72
73 972ac6af Benoit Parmentier
#Choose interpolation method...
74
interpolation_method<-c("gam_fusion","gam_CAI") #other otpions to be added later
75
76 c1e1cc30 Benoit Parmentier
#Default name of LST avg to be matched               
77
lst_avg<-c("mm_01","mm_02","mm_03","mm_04","mm_05","mm_06","mm_07","mm_08","mm_09","mm_10","mm_11","mm_12")  
78
79 972ac6af Benoit Parmentier
in_path<-"/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/input_data"
80
#Create on the fly output folder...
81
out_path<-"/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/output_data"
82
script_path<-"/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/"
83
setwd(in_path)
84
85 33095a53 Benoit Parmentier
86
list_param_data_prep<-c(infile_monthly,infile_daily,infile_locs,infile_covariates,var,out_prefix,CRS_locs_WGS84)
87
list_param_raster_prediction<-c(list_param_data_prep,
88
                                seed_number,nb_sample,step,constant,prop_minmax,infile_dates,
89
                                list_models,lst_avg,in_path,out_path,script_path,
90
                                interpolation_method)
91
92
93
source(file.path(script_path,"sampling_script_functions_03052013.R"))
94
source(file.path(script_path,"GAM_fusion_function_multisampling_03052013.R"))
95 1508a57e Benoit Parmentier
source(file.path(script_path,"GAM_fusion_function_multisampling_validation_metrics_02262013.R"))
96
97 33095a53 Benoit Parmentier
98 fb039a6b Benoit Parmentier
###################### START OF THE SCRIPT ########################
99 e7bf2d1b Benoit Parmentier
100 33095a53 Benoit Parmentier
101
if (var=="TMAX"){
102
  y_var_name<-"dailyTmax"                                       
103
}
104
if (var=="TMIN"){
105
  y_var_name<-"dailyTmin"                                       
106
}
107
108 1508a57e Benoit Parmentier
################# CREATE LOG FILE #####################
109
110
#create log file to keep track of details such as processing times and parameters.
111 c1e1cc30 Benoit Parmentier
112 33095a53 Benoit Parmentier
log_fname<-paste("R_log_raster_prediction",out_prefix, ".log",sep="")
113 c1e1cc30 Benoit Parmentier
114
if (file.exists(log_fname)){  #Stop the script???
115
  file.remove(log_fname)
116
  log_file<-file(log_fname,"w")
117
}
118
if (!file.exists(log_fname)){
119
  log_file<-file(log_fname,"w")
120
}
121
122
time1<-proc.time()    #Start stop watch
123
writeLines(paste("Starting script at this local Date and Time: ",as.character(Sys.time()),sep=""),
124
           con=log_file,sep="\n")
125
writeLines("Starting script process time:",con=log_file,sep="\n")
126
writeLines(as.character(time1),con=log_file,sep="\n")    
127
128 33095a53 Benoit Parmentier
############### READING INPUTS: DAILY STATION DATA AND OTEHR DATASETS  #################
129 1508a57e Benoit Parmentier
130 33095a53 Benoit Parmentier
ghcn<-readOGR(dsn=in_path,layer=sub(".shp","",basename(infile_daily)))
131 96c5053f Benoit Parmentier
CRS_interp<-proj4string(ghcn)                       #Storing projection information (ellipsoid, datum,etc.)
132 33095a53 Benoit Parmentier
stat_loc<-readOGR(dsn=in_path,layer=sub(".shp","",basename(infile_locs)))
133
dates <-readLines(file.path(in_path,infile_dates)) #dates to be predicted
134 e7bf2d1b Benoit Parmentier
135 972ac6af Benoit Parmentier
#Reading of covariate brick covariates can be changed...
136 33095a53 Benoit Parmentier
              
137
s_raster<-brick(infile_covariates)                   #read in the data brck
138 96c5053f Benoit Parmentier
names(s_raster)<-covar_names               #Assigning names to the raster layers: making sure it is included in the extraction
139 33095a53 Benoit Parmentier
pos<-match("elev",names(s_raster))
140
names(s_raster)[pos]<-"elev_1"
141
142
#Screen for extreme values": this needs more thought, min and max val vary with regions
143
#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)
144
#r1[r1 < (min_val)]<-NA
145 96c5053f Benoit Parmentier
146 972ac6af Benoit Parmentier
#Reading monthly data
147 33095a53 Benoit Parmentier
data3<-readOGR(dsn=in_path,layer=sub(".shp","",basename(infile_monthly)))
148 760957d7 Benoit Parmentier
dst_all<-data3
149
dst<-data3
150
151 972ac6af Benoit Parmentier
### TO DO -important ###
152 33095a53 Benoit Parmentier
#Cleaning/sceerniging functions for daily stations, monthly stations and covariates?? do this during the preparation stage!!!??
153
###
154 e7bf2d1b Benoit Parmentier
155 33095a53 Benoit Parmentier
########### CREATE SAMPLING -TRAINING AND TESTING STATIONS ###########
156 e7bf2d1b Benoit Parmentier
157 33095a53 Benoit Parmentier
#Input for sampling function...
158 e7bf2d1b Benoit Parmentier
159 33095a53 Benoit Parmentier
#dates #list of dates for prediction
160
#ghcn_name<-"ghcn" #infile daily data 
161 e7bf2d1b Benoit Parmentier
162 33095a53 Benoit Parmentier
list_param_sampling<-list(seed_number,nb_sample,step,constant,prop_minmax,dates,ghcn)
163
#list_param_sampling<-list(seed_number,nb_sample,step,constant,prop_minmax,dates,ghcn_name)
164
names(list_param_sampling)<-c("seed_number","nb_sample","step","constant","prop_minmax","dates","ghcn")
165
166
#run function
167
sampling_obj<-sampling_training_testing(list_param_sampling)
168 fb039a6b Benoit Parmentier
169 e7bf2d1b Benoit Parmentier
170 33095a53 Benoit Parmentier
########### PREDICT FOR MONTHLY SCALE  ##################
171 e7bf2d1b Benoit Parmentier
172 0f602e87 Benoit Parmentier
#First predict at the monthly time scale: climatology
173 c1e1cc30 Benoit Parmentier
writeLines("Predictions at monthly scale:",con=log_file,sep="\n")
174
t1<-proc.time()
175
gamclim_fus_mod<-mclapply(1:12, runClim_KGFusion,mc.preschedule=FALSE,mc.cores = 6) #This is the end bracket from mclapply(...) statement
176 33095a53 Benoit Parmentier
#gamclim_fus_mod<-mclapply(1:6, runClim_KGFusion,mc.preschedule=FALSE,mc.cores = 6) #This is the end bracket from mclapply(...) statement
177 0f602e87 Benoit Parmentier
save(gamclim_fus_mod,file= paste("gamclim_fus_mod",out_prefix,".RData",sep=""))
178 c1e1cc30 Benoit Parmentier
t2<-proc.time()-t1
179
writeLines(as.character(t2),con=log_file,sep="\n")
180 e7bf2d1b Benoit Parmentier
181 0f602e87 Benoit Parmentier
#now get list of raster clim layers
182 e7bf2d1b Benoit Parmentier
183 0f602e87 Benoit Parmentier
list_tmp<-vector("list",length(gamclim_fus_mod))
184
for (i in 1:length(gamclim_fus_mod)){
185
  tmp<-gamclim_fus_mod[[i]]$clim
186
  list_tmp[[i]]<-tmp
187 e7bf2d1b Benoit Parmentier
}
188
189 1508a57e Benoit Parmentier
################## PREDICT AT DAILY TIME SCALE #################
190
191 0f602e87 Benoit Parmentier
#put together list of clim models per month...
192 33095a53 Benoit Parmentier
#rast_clim_yearlist<-list_tmp
193
clim_yearlist<-list_tmp
194 0f602e87 Benoit Parmentier
#Second predict at the daily time scale: delta
195
196
#gam_fus_mod<-mclapply(1:1, runGAMFusion,mc.preschedule=FALSE,mc.cores = 1) #This is the end bracket from mclapply(...) statement
197 c1e1cc30 Benoit Parmentier
writeLines("Predictions at the daily scale:",con=log_file,sep="\n")
198
t1<-proc.time()
199 33095a53 Benoit Parmentier
200
#input a list:note that ghcn.subsets is not sampling_obj$data_day_ghcn
201
list_param_runGAMFusion<-list(i,clim_yearlist,sampling_obj,dst,var,y_var_name, out_prefix)
202
names(list_param_runGAMFusion)<-c("list_index","clim_yearlist","sampling_obj","dst","var","y_var_name","out_prefix")
203
#test<-mclapply(1:18, runGAMFusion,list_param=list_param_runGAMFusion,mc.preschedule=FALSE,mc.cores = 9)
204
205
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
206
207
#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
208
#gam_fus_mod<-mclapply(1:length(ghcn.subsets), runGAMFusion,mc.preschedule=FALSE,mc.cores = 9) #This is the end bracket from mclapply(...) statement
209 0f602e87 Benoit Parmentier
save(gam_fus_mod,file= paste("gam_fus_mod",out_prefix,".RData",sep=""))
210 c1e1cc30 Benoit Parmentier
t2<-proc.time()-t1
211
writeLines(as.character(t2),con=log_file,sep="\n")
212 e7bf2d1b Benoit Parmentier
213 1508a57e Benoit Parmentier
############### NOW RUN VALIDATION #########################
214
215 0f602e87 Benoit Parmentier
list_tmp<-vector("list",length(gam_fus_mod))
216
for (i in 1:length(gam_fus_mod)){
217
  tmp<-gam_fus_mod[[i]][[y_var_name]]  #y_var_name is the variable predicted (tmax or tmin)
218
  list_tmp[[i]]<-tmp
219
}
220 c1e1cc30 Benoit Parmentier
rast_day_yearlist<-list_tmp #list of predicted images
221 0f602e87 Benoit Parmentier
222 c1e1cc30 Benoit Parmentier
writeLines("Validation step:",con=log_file,sep="\n")
223
t1<-proc.time()
224 0f602e87 Benoit Parmentier
#calculate_accuary_metrics<-function(i)
225
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
226
#gam_fus_validation_mod<-mclapply(1:1, calculate_accuracy_metrics,mc.preschedule=FALSE,mc.cores = 1) #This is the end bracket from mclapply(...) statement
227
save(gam_fus_validation_mod,file= paste("gam_fus_validation_mod",out_prefix,".RData",sep=""))
228 c1e1cc30 Benoit Parmentier
t2<-proc.time()-t1
229
writeLines(as.character(t2),con=log_file,sep="\n")
230 0766370d Benoit Parmentier
231 1508a57e Benoit Parmentier
#################### ASSESSMENT OF PREDICTIONS: PLOTS OF ACCURACY METRICS ###########
232 0766370d Benoit Parmentier
233 1508a57e Benoit Parmentier
##Create data.frame with valiation metrics for a full year
234
tb_diagnostic_v<-extract_from_list_obj(gam_fus_validation_mod,"metrics_v")
235
rownames(tb_diagnostic_v)<-NULL #remove row names
236 e7bf2d1b Benoit Parmentier
237 1508a57e Benoit Parmentier
#Call function to create plots of metrics for validation dataset
238
metric_names<-c("rmse","mae","me","r","m50")
239
summary_metrics<-boxplot_from_tb(tb_diagnostic_v,metric_names,out_prefix)
240
names(summary_metrics)<-c("avg","median")
241
##Write out information concerning accuracy and predictions
242
outfile<-file.path(in_path,paste("assessment_measures_",out_prefix,".txt",sep=""))
243
write.table(tb_diagnostic_v,file= outfile,row.names=FALSE,sep=",")
244
write.table(summary_metrics[[1]], file= outfile, append=TRUE,sep=",") #write out avg
245
write.table(summary_metrics[[2]], file= outfile, append=TRUE,sep=",") #write out median
246
247
#################### CLOSE LOG FILE  #############
248 e7bf2d1b Benoit Parmentier
249 c1e1cc30 Benoit Parmentier
#close log_file connection and add meta data
250
writeLines("Finished script process time:",con=log_file,sep="\n")
251
time2<-proc.time()-time1
252
writeLines(as.character(time2),con=log_file,sep="\n")
253
#later on add all the paramters used in the script...
254
writeLines(paste("Finished script at this local Date and Time: ",as.character(Sys.time()),sep=""),
255
           con=log_file,sep="\n")
256
writeLines("End of script",con=log_file,sep="\n")
257
close(log_file)
258
259 1508a57e Benoit Parmentier
############################################################
260
######################## END OF SCRIPT #####################