Project

General

Profile

« Previous | Next » 

Revision bb747d71

Added by Benoit Parmentier about 11 years ago

validation script, modifications to make use of same function for daily and monthly accuracy calculations

View differences:

climate/research/oregon/interpolation/GAM_fusion_function_multisampling_validation_metrics.R
72 72
73 73 
  #PARSING INPUT PARAMETERS
74 74 
  out_path <- list_param$out_path
75 
  day_list <- list_param$rast_day_year_list[[i]]
76 
  #day_list <-rast_day_yearlist[[i]] #list of prediction for the current date...
77 
  names_mod <- names(day_list)
78 
  method_mod_obj <- list_param$method_mod_obj
75 
  day_list <- list_param$rast_day_year_list[[i]] #this is the list of raster files, may be daily or monthly predictions
76 
  names_mod <- names(day_list) #names of the predicted variables
79 77 

  		




  80
  
  
    
  y_var_name <- list_param$y_var_name #missing--debugging


  		




  
  78
  
    
  y_ref <- list_param$y_ref  #This is the reference variable from which resituals and accuracy metrics are created


  		




  81
  79
  
    
  multi_time_scale <- list_param$multi_time_scale


  		




  82
  80
  
    
  


  		




  83
  
  
    
  if(multi_time_scale==TRUE){


  		




  84
  
  
    
    data_v <- method_mod_obj[[i]]$data_month_v


  		




  85
  
  
    
    data_s <- method_mod_obj[[i]]$data_month_s


  		




  86
  
  
    
    daily_dev_sampling_dat <- method_mod_obj[[i]]$daily_dev_sampling_dat


  		




  87
  
  
    
    sampling_dat_day <- method_mod_obj[[i]]$daily_dev_sampling_dat


  		




  88
  
  
    
  }else{


  		




  89
  
  
    
    #Change to results_mod_obj[[i]]$data_s to make it less specific


  		




  90
  
  
    
    data_v <- method_mod_obj[[i]]$data_v


  		




  91
  
  
    
    data_s <- method_mod_obj[[i]]$data_s


  		




  92
  
  
    
    sampling_dat_day <- (method_mod_obj[[i]])$sampling_dat


  		




  93
  
  
    
  }


  		




  
  81
  
    
  data_v <- list_param$list_data_v[[i]]


  		




  
  82
  
    
  data_s <- list_param$list_data_s[[i]]


  		




  
  83
  
    
  sampling_dat_day <- list_param$list_sampling_dat[[i]]


  		




  94
  84
  
    
  


  		




  95
  85
  
    
  ## Now create the stack


  		




  96
  86
  
    
  


  		




  ......




  98
  88
  
    
  names(rast_day_mod) <- names(day_list)


  		




  99
  89
  
    
  #Change to handle cases in which data_v is NULL!!!


  		




  100
  90
  
    
    


  		




  101
  
  
    
  ns<-nrow(data_s) # some loss of data might have happened because of the averaging...


  		




  102
  
  
    
  nv<-nrow(data_v)


  		




  
  91
  
    
  ns <- nrow(data_s) # some loss of data might have happened because of the averaging...


  		




  
  92
  
    
  nv <- nrow(data_v)


  		




  103
  93
  
    
  


  		




  104
  
  
    

  		




  105
  94
  
    
  #add sampling dat info...


  		




  106
  95
  
    
  N=length(names_mod)


  		




  107
  96
  
    
  


  		




  ......




  112
  101
  
    
    


  		




  113
  102
  
    
    extract_data_v<-extract(rast_day_mod,data_v,df=TRUE)


  		




  114
  103
  
    
    data_v <-spCbind(data_v,extract_data_v) #should match IDs before joining for good practice    


  		




  115
  
  
    
    metrics_v_obj<-calc_val_metrics_rast(data_v,y_var_name,names_mod)


  		




  
  104
  
    
    metrics_v_obj<-calc_val_metrics_rast(data_v,y_ref,names_mod)


  		




  116
  105
  
    
    metrics_v_df<-cbind(metrics_v_obj$metrics,run_info)


  		




  117
  
  
    
    metrics_v_df["var_interp"]<-rep(y_var_name,times=nrow(metrics_v_df)) 


  		




  
  106
  
    
    metrics_v_df["var_interp"]<-rep(y_ref,times=nrow(metrics_v_df)) 


  		




  118
  107
  
    
    #Name of the variable interpolated, useful for cross-comparison between methods at later stages


  		




  119
  108
  
    
    data_v<-spCbind(data_v,metrics_v_obj$residuals)


  		




  120
  
  
    
    


  		




  121
  109
  
    
  }


  		




  122
  110
  
    
  


  		




  123
  111
  
    
  extract_data_s<-extract(rast_day_mod,data_s,df=TRUE)  


  		




  
  112
  
    
  


  		




  124
  113
  
    
  data_s <-spCbind(data_s,extract_data_s)


  		




  125
  114
  
    

  		




  126
  
  
    
  metrics_s_obj <- calc_val_metrics_rast(data_s,y_var_name,names_mod)  


  		




  
  115
  
    
  metrics_s_obj <- calc_val_metrics_rast(data_s,y_ref,names_mod)  


  		




  
  116
  
    
  


  		




  127
  117
  
    
  run_info <- cbind(sampling_dat_day,n=ns)


  		




  128
  118
  
    
  run_info[rep(seq_len(nrow(run_info)), each=N),]


  		




  129
  119
  
    
  metrics_s_df <- cbind(metrics_s_obj$metrics,run_info)


  		




  130
  
  
    
  metrics_s_df["var_interp"] <- rep(y_var_name,times=nrow(metrics_s_df)) 


  		




  
  120
  
    
  metrics_s_df["var_interp"] <- rep(y_ref,times=nrow(metrics_s_df)) 


  		




  131
  121
  
    
  #Name of the variable interpolated, useful for cross-comparison between methods at later stages


  		




  132
  122
  
    
  


  		




  133
  123
  
    
  data_s <- spCbind(data_s,metrics_s_obj$residuals)


  		












Also available in:  Unified diff