Revision 4210cc6c
Added by Benoit Parmentier over 8 years ago
climate/research/oregon/interpolation/global_run_scalingup_mosaicing.R | ||
---|---|---|
5 | 5 |
#Analyses, figures, tables and data are also produced in the script. |
6 | 6 |
#AUTHOR: Benoit Parmentier |
7 | 7 |
#CREATED ON: 04/14/2015 |
8 |
#MODIFIED ON: 06/08/2016
|
|
8 |
#MODIFIED ON: 06/09/2016
|
|
9 | 9 |
#Version: 6 |
10 | 10 |
#PROJECT: Environmental Layers project |
11 | 11 |
#COMMENTS: analyses run for reg4 1991 for test of mosaicing using 1500x4500km and other tiles |
... | ... | |
284 | 284 |
###Depending on value of layers_option, create accuracy surfaces based on day testing metric (e.g. rmse)... |
285 | 285 |
#Generate accuracy layers using tiles definitions and output from the accuracy assessment |
286 | 286 |
|
287 |
#browser() |
|
287 |
|
|
288 |
|
|
289 |
#### create a function to generate accuracy layers by tiles |
|
290 |
generate_ac_assessment_layers_by_tile <- function(lf,layers_option,df,df_tile_processed,metric_name, |
|
291 |
var_pred,list_models,use_autokrige,pred_mod_name, |
|
292 |
y_var_name,interpolation_method, |
|
293 |
days_to_process,num_cores,NA_flag_val,file_format, |
|
294 |
out_dir,out_suffix){ |
|
295 |
|
|
296 |
#PARAMETERS: |
|
297 |
#lf |
|
298 |
#layers_option |
|
299 |
#df: can be tb,tb_s, data_v or data_s |
|
300 |
#df_tile_processed |
|
301 |
#metric_name <- "rmse" #RMSE, MAE etc. |
|
302 |
#var_pred: e.g. res_mod1, used for kriging of residuals in res_testing or res_training option |
|
303 |
#list_models: NULL then generate the formula for kriging |
|
304 |
#use_autokrige |
|
305 |
#pred_mod_name <- "mod1" |
|
306 |
#y_var_name |
|
307 |
#interpolation_method #c("gam_CAI") #PARAM3 |
|
308 |
|
|
309 |
#days_to_process <- day_to_mosaic |
|
310 |
#num_cores |
|
311 |
#NA_flag_val <- list_param$NA_flag_val |
|
312 |
#file_format <- list_param$file_format |
|
313 |
#out_dir |
|
314 |
#out_suffix |
|
315 |
# |
|
316 |
|
|
317 |
#OUTPUT |
|
318 |
# |
|
319 |
#add options to clean up file after use!! |
|
320 |
|
|
321 |
############################### |
|
322 |
|
|
323 |
### START ##### |
|
324 |
|
|
325 |
out_dir_str <- out_dir |
|
326 |
out_suffix_str <- out_suffix |
|
327 |
#lf <- lf_mosaic |
|
328 |
|
|
329 |
#Improved by adding multicores option |
|
330 |
num_cores_tmp <- num_cores |
|
331 |
|
|
332 |
if(layers_option=="ac_training" | layers_option=="ac_testing"){ |
|
333 |
|
|
334 |
list_param_accuracy_metric_raster <- list(lf,df,metric_name,pred_mod_name,y_var_name,interpolation_method, |
|
335 |
days_to_process,num_cores_tmp,NA_flag_val,file_format,out_dir_str,out_suffix_str) |
|
336 |
names(list_param_accuracy_metric_raster) <- c("lf","tb","metric_name","pred_mod_name","y_var_name","interpolation_method", |
|
337 |
"days_to_process","num_cores","NA_flag_val","file_format","out_dir_str","out_suffix_str") |
|
338 |
list_raster_created_obj <- lapply(1:length(days_to_process),FUN=create_accuracy_metric_raster, |
|
339 |
list_param=list_param_accuracy_metric_raster) |
|
340 |
|
|
341 |
#debug(create_accuracy_metric_raster) |
|
342 |
#list_raster_created_obj <- lapply(1:1,FUN=create_accuracy_metric_raster, |
|
343 |
# list_param=list_param_accuracy_metric_raster) |
|
344 |
#raster_created_obj <- create_accuracy_metric_raster(1, list_param_accuracy_metric_raster) |
|
345 |
|
|
346 |
#Extract list of files for rmse and date 1 (19920101), there should be 28 raster images |
|
347 |
lf_accuracy_raster <- lapply(1:length(list_raster_created_obj),FUN=function(i){unlist(list_raster_created_obj[[i]]$list_raster_name)}) |
|
348 |
|
|
349 |
lf_ac_assessment_layers <- lf_accuracy_raster |
|
350 |
|
|
351 |
} |
|
352 |
|
|
353 |
if(layers_option=="res_training" | layers_option=="res_testing"){ |
|
354 |
|
|
355 |
## Create accuracy surface by kriging |
|
356 |
#num_cores_tmp <-num_cores |
|
357 |
#lf_day_tiles <- lf_mosaic #list of raster files by dates |
|
358 |
lf_day_tiles <- lf #list of raster files by dates |
|
359 |
#data_df <- data_day_v # data.frame table/spdf containing stations with residuals and variable |
|
360 |
|
|
361 |
#df_tile_processed #tiles processed during assessment usually by region |
|
362 |
#var_pred #variable being modeled |
|
363 |
#if not list of models is provided generate one |
|
364 |
if(is.null(list_models)){ |
|
365 |
list_models <- paste(var_pred,"~","1",sep=" ") #can krige any variable here |
|
366 |
} |
|
367 |
|
|
368 |
#use_autokrige #if TRUE use automap/gstat package |
|
369 |
#y_var_name #"dailyTmax" #PARAM2 |
|
370 |
#interpolation_method #c("gam_CAI") #PARAM3, need to select reg!! |
|
371 |
#date_processed #can be a monthly layer |
|
372 |
#num_cores #number of cores used |
|
373 |
#NA_flag_val |
|
374 |
#file_format |
|
375 |
#out_dir_str <- out_dir #change to specific separate dir?? |
|
376 |
#out_suffix_str <- out_suffix |
|
377 |
#days_to_process <- day_to_mosaic |
|
378 |
|
|
379 |
#out_suffix_str <- paste("data_day_v_",out_suffix,sep="") |
|
380 |
out_suffix_str <- paste(layers_option,var_pred,out_suffix,sep="") |
|
381 |
#browser() |
|
382 |
df_tile_processed$path_NEX <- as.character(df_tile_processed$path_NEX) |
|
383 |
df_tile_processed$reg <- basename(dirname(df_tile_processed$path_NEX)) |
|
384 |
|
|
385 |
##By regions, selected earlier |
|
386 |
#for(k in 1:length(region_names)){ |
|
387 |
df_tile_processed_reg <- subset(df_tile_processed,reg==region_selected)#use reg4 |
|
388 |
#i<-1 #loop by days/date to process!! |
|
389 |
#test on the first day |
|
390 |
list_param_create_accuracy_residuals_raster <- list(lf,df,df_tile_processed_reg, |
|
391 |
var_pred,list_models,use_autokrige,y_var_name,interpolation_method, |
|
392 |
days_to_process,num_cores_tmp,NA_flag_val,file_format,out_dir_str, |
|
393 |
out_suffix_str) |
|
394 |
names(list_param_create_accuracy_residuals_raster) <- c("lf_day_tiles","data_df","df_tile_processed_reg", |
|
395 |
"var_pred","list_models","use_autokrige","y_var_name","interpolation_method", |
|
396 |
"days_to_process","num_cores_tmp","NA_flag_val","file_format","out_dir_str", |
|
397 |
"out_suffix_str") |
|
398 |
#browser() |
|
399 |
list_create_accuracy_residuals_raster_obj <- lapply(1:length(day_to_mosaic),FUN=create_accuracy_residuals_raster, |
|
400 |
list_param=list_param_create_accuracy_residuals_raster) |
|
401 |
|
|
402 |
#undebug(create_accuracy_residuals_raster) |
|
403 |
#list_create_accuracy_residuals_raster_obj <- lapply(1:1,FUN=create_accuracy_residuals_raster, |
|
404 |
# list_param=list_param_create_accuracy_residuals_raster) |
|
405 |
|
|
406 |
#create_accuracy_residuals_raster_obj <- create_accuracy_residuals_raster(1, list_param_create_accuracy_residuals_raster_obj) |
|
407 |
|
|
408 |
#note that three tiles did not produce a residuals surface!!! find out more later, join the output |
|
409 |
#to df_raste_tile to keep track of which one did not work... |
|
410 |
#lf_accuracy_residuals_raster <- as.character(unlist(lapply(1:length(list_create_accuracy_residuals_raster_obj),FUN=function(i,x){unlist(extract_from_list_obj(x[[i]]$list_pred_res_obj,"raster_name"))},x=list_create_accuracy_residuals_raster_obj))) |
|
411 |
lf_accuracy_residuals_raster <- lapply(1:length(list_create_accuracy_residuals_raster_obj),FUN=function(i,x){as.character(unlist(extract_from_list_obj(x[[i]]$list_pred_res_obj,"raster_name")))},x=list_create_accuracy_residuals_raster_obj) |
|
412 |
lf_ac_assessment_layers <- lf_accuracy_residuals_raster |
|
413 |
} |
|
414 |
|
|
415 |
return(lf_ac_assessment_layers) |
|
416 |
|
|
417 |
} |
|
418 |
|
|
419 |
browser() |
|
420 |
|
|
421 |
#try running the function now: |
|
422 |
|
|
423 |
lf <- lf_mosaic[i] |
|
288 | 424 |
|
425 |
df <- tb #for ac_testing |
|
426 |
days_to_process <- day_to_mosaic[i] |
|
427 |
|
|
428 |
#browser() |
|
429 |
debug(generate_ac_assessment_layers_by_tile) |
|
430 |
generate_ac_assessment_layers_by_tile(lf,layers_option,df,df_tile_processed,metric_name, |
|
431 |
var_pred,list_models,use_autokrige,pred_mod_name, |
|
432 |
y_var_name,interpolation_method, |
|
433 |
days_to_process,num_cores,NA_flag_val,file_format, |
|
434 |
out_dir,out_suffix) #### create a function to generate accuracy layers by tiles |
|
435 |
|
|
289 | 436 |
if(layers_option=="ac_testing"){ |
290 | 437 |
#this takes about 1 minute and 35 seconds for 3 days and 28 tiles... |
291 | 438 |
#add options to clean up file after use!! |
... | ... | |
324 | 471 |
#browser() |
325 | 472 |
|
326 | 473 |
} |
327 |
|
|
474 |
|
|
475 |
|
|
476 |
|
|
328 | 477 |
#### Add option for ac training here |
329 | 478 |
|
330 | 479 |
if(layers_option=="ac_training"){ |
Also available in: Unified diff
adding function to generate accuracy layer by tiles before mosaicing