Revision 574cd927
Added by Benoit Parmentier over 11 years ago
| climate/research/oregon/interpolation/GAM_fusion_function_multisampling.R | ||
|---|---|---|
| 8 | 8 |
# 5)runGAMFusion <- function(i,list_param) : daily step for fusion method, perform daily prediction |
| 9 | 9 |
# |
| 10 | 10 |
#AUTHOR: Benoit Parmentier |
| 11 |
#DATE: 05/07/2013
|
|
| 11 |
#DATE: 07/29/2013
|
|
| 12 | 12 |
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#363-- |
| 13 | 13 |
|
| 14 | 14 |
##Comments and TODO: |
| ... | ... | |
| 60 | 60 |
#### |
| 61 | 61 |
#TODO: |
| 62 | 62 |
#Add log file and calculate time and sizes for processes-outputs |
| 63 |
#Can combine runClim_KGFusion and runClim_KGCAI |
|
| 63 | 64 |
runClim_KGCAI <-function(j,list_param){
|
| 64 | 65 |
|
| 65 | 66 |
#Make this a function with multiple argument that can be used by mcmapply?? |
| ... | ... | |
| 105 | 106 |
LST_name<-lst_avg[j] # name of LST month to be matched |
| 106 | 107 |
data_month$LST<-data_month[[LST_name]] |
| 107 | 108 |
|
| 108 |
#Create formulas object from list of characters... |
|
| 109 |
list_formulas<-lapply(list_models,as.formula,env=.GlobalEnv) #mulitple arguments passed to lapply!! |
|
| 110 |
|
|
| 111 | 109 |
#TMax to model... |
| 112 | 110 |
if (var=="TMAX"){
|
| 113 | 111 |
data_month$y_var<-data_month$TMax #Adding TMax as the variable modeled |
| ... | ... | |
| 116 | 114 |
data_month$y_var<-data_month$TMin #Adding TMin as the variable modeled |
| 117 | 115 |
} |
| 118 | 116 |
#Fit gam models using data and list of formulas |
| 119 |
mod_list<-fit_models(list_formulas,data_month) #only gam at this stage |
|
| 120 |
cname<-paste("mod",1:length(mod_list),sep="") #change to more meaningful name?
|
|
| 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?
|
|
| 121 | 123 |
names(mod_list)<-cname |
| 122 | 124 |
#Adding layer LST to the raster stack |
| 123 | 125 |
|
| ... | ... | |
| 139 | 141 |
list_out_filename[[k]]<-raster_name |
| 140 | 142 |
} |
| 141 | 143 |
|
| 142 |
#now predict values for raster image... |
|
| 143 |
rast_clim_list<-predict_raster_model(mod_list,s_raster,list_out_filename) |
|
| 144 |
names(rast_clim_list)<-cname |
|
| 145 |
#Some models will not be predicted because of the lack of training data...remove empty string from list of models |
|
| 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 |
|
|
| 146 | 177 |
rast_clim_list<-rast_clim_list[!sapply(rast_clim_list,is.null)] #remove NULL elements in list |
| 147 | 178 |
|
| 148 | 179 |
#Adding Kriging for Climatology options |
| ... | ... | |
| 154 | 185 |
model_name<-"mod_kr" |
| 155 | 186 |
|
| 156 | 187 |
clim_rast<-interpolate(LST,fitclim) #interpolation using function from raster package |
| 157 |
#Saving kriged surface in raster images |
|
| 158 |
#data_name<-paste("clim_month_",j,"_",model_name,"_",prop_month,
|
|
| 159 |
# "_",run_samp,sep="") |
|
| 160 |
#raster_name_clim<-paste("fusion_",data_name,out_prefix,".tif", sep="")
|
|
| 161 |
#writeRaster(clim_rast, filename=raster_name_clim,overwrite=TRUE) #Writing the data in a raster file format...(IDRISI) |
|
| 162 | 188 |
|
| 163 |
#now climatology layer
|
|
| 164 |
#clim_rast<-LST-bias_rast |
|
| 189 |
#Write out modeled layers
|
|
| 190 |
|
|
| 165 | 191 |
data_name<-paste(var,"_clim_month_",j,"_",model_name,"_",prop_month, |
| 166 | 192 |
"_",run_samp,sep="") |
| 167 | 193 |
raster_name_clim<-file.path(out_path,paste("CAI_",data_name,out_prefix,".tif", sep=""))
|
| ... | ... | |
| 276 | 302 |
|
| 277 | 303 |
} |
| 278 | 304 |
|
| 279 |
## need to change to use combined gwr autokrige function |
|
| 280 |
if (interpolation_method=="kriging_fusion"){
|
|
| 281 |
method_interp <- "kriging" |
|
| 282 |
month_prediction_obj<-predict_auto_krige_raster_model(list_formulas,s_raster,data_month,list_out_filename) |
|
| 283 |
#month_prediction_obj<-predict_autokrige_gwr_raster_model(method_interp,list_formulas,s_raster,data_s,list_out_filename) |
|
| 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) |
|
| 284 | 316 |
|
| 285 | 317 |
mod_list <-month_prediction_obj$list_fitted_models |
| 286 | 318 |
rast_bias_list <-month_prediction_obj$list_rast_pred |
| 287 | 319 |
names(rast_bias_list)<-cname |
| 288 | 320 |
} |
| 289 | 321 |
|
| 290 |
if (interpolation_method=="gwr_fusion"){
|
|
| 291 |
method_interp <- "gwr" |
|
| 292 |
day_prediction_obj<-predict_autokrige_gwr_raster_model(method_interp,list_formulas,s_raster,data_s,list_out_filename) |
|
| 293 |
mod_list <-day_prediction_obj$list_fitted_models |
|
| 294 |
rast_day_list <-day_prediction_obj$list_rast_pred |
|
| 295 |
names(rast_day_list)<-cname |
|
| 296 |
} |
|
| 297 |
|
|
| 298 | 322 |
#Some modles will not be predicted...remove them |
| 299 | 323 |
rast_bias_list<-rast_bias_list[!sapply(rast_bias_list,is.null)] #remove NULL elements in list |
| 300 | 324 |
|
| ... | ... | |
| 347 | 371 |
rast_clim_list[[model_name]]<-NULL |
| 348 | 372 |
} |
| 349 | 373 |
|
| 350 |
|
|
| 351 | 374 |
#### STEP 5: Prepare object and return |
| 352 | 375 |
|
| 353 | 376 |
clim_obj<-list(rast_bias_list,rast_clim_list,data_month,mod_list,list_formulas) |
Also available in: Unified diff
modification for gwr fusion and additional methods for CAI