Project

General

Profile

« Previous | Next » 

Revision 4210cc6c

Added by Benoit Parmentier over 8 years ago

adding function to generate accuracy layer by tiles before mosaicing

View differences:

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