Revision eec6f6d5
Added by Benoit Parmentier over 11 years ago
| climate/research/oregon/interpolation/GAM_fusion_function_multisampling.R | ||
|---|---|---|
| 61 | 61 |
#### |
| 62 | 62 |
#TODO: |
| 63 | 63 |
#Add log file and calculate time and sizes for processes-outputs |
| 64 |
runClimCAI<-function(j){
|
|
| 64 |
runClimCAI<-function(j,list_param){
|
|
| 65 |
|
|
| 65 | 66 |
#Make this a function with multiple argument that can be used by mcmapply?? |
| 66 |
#This creates clim fusion layers...still needs more code testing |
|
| 67 |
|
|
| 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 |
# |
|
| 78 |
#The output is a list of four shapefile names produced by the function: |
|
| 79 |
#1) clim: list of output names for raster climatogies |
|
| 80 |
#2) data_month: monthly training data for bias surface modeling |
|
| 81 |
#3) mod: list of model objects fitted |
|
| 82 |
#4) formulas: list of formulas used in bias modeling |
|
| 83 |
|
|
| 84 |
### PARSING INPUT ARGUMENTS |
|
| 85 |
#list_param_runGAMFusion<-list(i,clim_yearlist,sampling_obj,var,y_var_name, out_prefix) |
|
| 86 |
|
|
| 87 |
index<-list_param$j |
|
| 88 |
s_raster<-list_param$covar_rast |
|
| 89 |
covar_names<-list_param$covar_names |
|
| 90 |
lst_avg<-list_param$lst_avg |
|
| 91 |
list_models<-list_param$list_models |
|
| 92 |
dst<-list_param$dst #monthly station dataset |
|
| 93 |
var<-list_param$var |
|
| 94 |
y_var_name<-list_param$y_var_name |
|
| 95 |
out_prefix<-list_param$out_prefix |
|
| 96 |
|
|
| 68 | 97 |
#Model and response variable can be changed without affecting the script |
| 69 | 98 |
prop_month<-0 #proportion retained for validation |
| 70 | 99 |
run_samp<-1 |
| 71 | 100 |
|
| 72 |
list_formulas<-lapply(list_models,as.formula,env=.GlobalEnv) #mulitple arguments passed to lapply!!
|
|
| 73 |
|
|
| 101 |
#### STEP 2: PREPARE DATA
|
|
| 102 |
|
|
| 74 | 103 |
data_month<-dst[dst$month==j,] #Subsetting dataset for the relevant month of the date being processed |
| 75 | 104 |
LST_name<-lst_avg[j] # name of LST month to be matched |
| 76 | 105 |
data_month$LST<-data_month[[LST_name]] |
| 77 | 106 |
|
| 107 |
list_formulas<-lapply(list_models,as.formula,env=.GlobalEnv) #mulitple arguments passed to lapply!! |
|
| 108 |
|
|
| 78 | 109 |
#TMax to model... |
| 79 |
data_month$y_var<-data_month$TMax #Adding TMax as the variable modeled |
|
| 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 TMi as the variable modeled |
|
| 115 |
} |
|
| 116 |
|
|
| 80 | 117 |
mod_list<-fit_models(list_formulas,data_month) #only gam at this stage |
| 81 | 118 |
cname<-paste("mod",1:length(mod_list),sep="") #change to more meaningful name?
|
| 82 | 119 |
names(mod_list)<-cname |
| ... | ... | |
| 99 | 136 |
|
| 100 | 137 |
for (k in 1:length(list_out_filename)){
|
| 101 | 138 |
#j indicate which month is predicted |
| 102 |
data_name<-paste("clim_month_",j,"_",cname[k],"_",prop_month,
|
|
| 139 |
data_name<-paste(var,"_clim_month_",j,"_",cname[k],"_",prop_month,
|
|
| 103 | 140 |
"_",run_samp,sep="") |
| 104 | 141 |
raster_name<-paste("fusion_",data_name,out_prefix,".tif", sep="")
|
| 105 | 142 |
list_out_filename[[k]]<-raster_name |
| ... | ... | |
| 200 | 237 |
s_raster<-addLayer(s_raster,LST) #Adding current month |
| 201 | 238 |
|
| 202 | 239 |
#LST bias to model... |
| 203 |
#if (var==TMAX): will need to modify to take into account TMAX, TMIN and LST_day,LST_night |
|
| 204 |
data_month$LSTD_bias<-data_month$LST-data_month$TMax |
|
| 205 |
data_month$y_var<-data_month$LSTD_bias #Adding bias as the variable modeled |
|
| 240 |
if (var==TMAX){
|
|
| 241 |
data_month$LSTD_bias<-data_month$LST-data_month$TMax |
|
| 242 |
data_month$y_var<-data_month$LSTD_bias #Adding bias as the variable modeled |
|
| 243 |
} |
|
| 244 |
if (var==TMIN){
|
|
| 245 |
data_month$LSTD_bias<-data_month$LST-data_month$TMin |
|
| 246 |
data_month$y_var<-data_month$LSTD_bias #Adding bias as the variable modeled |
|
| 247 |
} |
|
| 206 | 248 |
|
| 207 | 249 |
#### STEP3: NOW FIT AND PREDICT MODEL |
| 208 | 250 |
|
| ... | ... | |
| 217 | 259 |
names(list_out_filename)<-cname |
| 218 | 260 |
|
| 219 | 261 |
for (k in 1:length(list_out_filename)){
|
| 220 |
#j indicate which month is predicted |
|
| 221 |
data_name<-paste("bias_LST_month_",j,"_",cname[k],"_",prop_month,
|
|
| 262 |
#j indicate which month is predicted, var indicates TMIN or TMAX
|
|
| 263 |
data_name<-paste(var,"_bias_LST_month_",j,"_",cname[k],"_",prop_month,
|
|
| 222 | 264 |
"_",run_samp,sep="") |
| 223 | 265 |
raster_name<-paste("fusion_",data_name,out_prefix,".tif", sep="")
|
| 224 | 266 |
list_out_filename[[k]]<-raster_name |
| ... | ... | |
| 349 | 391 |
########## |
| 350 | 392 |
|
| 351 | 393 |
modst<-dst[dst$month==mo,] #Subsetting dataset for the relevant month of the date being processed |
| 352 |
#Change to y_var...could be TMin |
|
| 353 |
#modst$LSTD_bias <- modst$LST-modst$y_var |
|
| 354 |
modst$LSTD_bias <- modst$LST-modst$TMax; #That is the difference between the monthly LST mean and monthly station mean |
|
| 394 |
|
|
| 395 |
if (var=="TMIN"){
|
|
| 396 |
modst$LSTD_bias <- modst$LST-modst$TMin; #That is the difference between the monthly LST mean and monthly station mean |
|
| 397 |
} |
|
| 398 |
if (var=="TMAX"){
|
|
| 399 |
modst$LSTD_bias <- modst$LST-modst$TMax; #That is the difference between the monthly LST mean and monthly station mean |
|
| 400 |
} |
|
| 401 |
#This may be unnecessary since LSTD_bias is already in dst?? check the info |
|
| 355 | 402 |
|
| 356 | 403 |
#Clearn out this part: make this a function call |
| 357 | 404 |
x<-as.data.frame(data_v) |
Also available in: Unified diff
GAM fusion starting modification to allow TMIN predictions, changes to CLIMCAI function