Revision 0f3064c3
Added by Benoit Parmentier about 10 years ago
| climate/research/oregon/interpolation/results_interpolation_date_output_analyses.R | ||
|---|---|---|
| 5 | 5 |
#Part 2: Examine |
| 6 | 6 |
#AUTHOR: Benoit Parmentier |
| 7 | 7 |
#DATE: 08/05/2013 |
| 8 |
#DATE MODIFIED: 05/21/2014
|
|
| 8 |
#DATE MODIFIED: 09/07/2014
|
|
| 9 | 9 |
|
| 10 | 10 |
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#???-- |
| 11 | 11 |
|
| ... | ... | |
| 71 | 71 |
in_path_tile <- list_param$in_path_tile |
| 72 | 72 |
|
| 73 | 73 |
if(!is.null(in_path_tile)){
|
| 74 |
covar_obj <- load_obj(list_param$covar_obj) |
|
| 74 |
#covar_obj <- load_obj(list_param$covar_obj)
|
|
| 75 | 75 |
infile_covariates <- file.path(in_path_tile,basename(covar_obj$infile_covariates)) |
| 76 | 76 |
covar_names <- covar_obj$covar_names |
| 77 | 77 |
}else{ #we are on the node or running as stage 5
|
| ... | ... | |
| 81 | 81 |
|
| 82 | 82 |
#if raster_obj has not been loaded in memory then we have |
| 83 | 83 |
#the name of the RData object for a specific tile |
| 84 |
raster_prediction_obj<-list_param$raster_prediction_obj
|
|
| 84 |
raster_prediction_obj <- list_param$raster_prediction_obj
|
|
| 85 | 85 |
if(class(raster_prediction_obj)=="character"){
|
| 86 | 86 |
raster_prediction_obj <- load_obj(raster_prediction_obj) |
| 87 | 87 |
} |
| ... | ... | |
| 116 | 116 |
LC_mask_rec[is.na(LC_mask_rec)]<- 0 |
| 117 | 117 |
|
| 118 | 118 |
#determine index position matching date selected |
| 119 |
i_dates<-vector("list",length(date_selected))
|
|
| 120 |
for (j in 1:length(date_selected)){
|
|
| 121 |
for (i in 1:length(method_mod_obj)){
|
|
| 122 |
if(method_mod_obj[[i]]$sampling_dat$date==date_selected[j]){
|
|
| 123 |
i_dates[[j]]<-i |
|
| 124 |
} |
|
| 125 |
} |
|
| 126 |
} |
|
| 119 |
#i_dates<-vector("list",length(date_selected))
|
|
| 120 |
#for (j in 1:length(date_selected)){
|
|
| 121 |
# for (i in 1:length(method_mod_obj)){
|
|
| 122 |
# if(try(method_mod_obj[[i]]$sampling_dat$date==date_selected[j])){
|
|
| 123 |
# i_dates[[j]]<-i |
|
| 124 |
# } |
|
| 125 |
# } |
|
| 126 |
#} |
|
| 127 |
|
|
| 128 |
metrics_s_list <- lapply(1:length(validation_mod_obj),FUN=function(x){metrics_s <- try(validation_mod_obj[[x]]$metrics_s)})
|
|
| 129 |
nb_days_fitted <- length(metrics_s_list) |
|
| 130 |
metrics_s_list <- metrics_s_list[unlist(lapply(metrics_s_list,FUN=function(x){!inherits(x,"try-error")}))]
|
|
| 131 |
nb_days_not_fitted <- nb_days_fitted - length(metrics_s_list) |
|
| 132 |
nb_days_fitted <- length(metrics_s_list) |
|
| 133 |
#Count number of try-error (not fitted) |
|
| 134 |
metrics_s_all <- do.call(rbind.fill,metrics_s_list) |
|
| 135 |
#Select predicted date... |
|
| 136 |
dat<- subset(metrics_s_all,date==date_selected_results) |
|
| 137 |
|
|
| 138 |
index <- unique(dat$index_d) |
|
| 127 | 139 |
#Examine the first select date add loop or function later |
| 128 | 140 |
#j=1 |
| 129 | 141 |
date <- strptime(date_selected[j], "%Y%m%d") # interpolation date being processed |
| 142 |
date <- strptime(date_selected, "%Y%m%d") # interpolation date being processed |
|
| 143 |
|
|
| 130 | 144 |
month <- strftime(date, "%m") # current month of the date being processed |
| 131 | 145 |
|
| 132 | 146 |
#Get raster stack of interpolated surfaces |
| 133 |
index <- i_dates[[j]] |
|
| 147 |
#index <- i_dates[[j]]
|
|
| 134 | 148 |
##The path of production is not the same if input_path_tile is not NULL |
| 135 | 149 |
if(!is.null(in_path_tile)){
|
| 136 | 150 |
#infile_covariates <- file.path(in_path_tile,basename(list_param$covar_obj$infile_covariates)) |
| ... | ... | |
| 243 | 257 |
title(paste("Predicted_versus_observed_",y_var_name,"_",model_name,"_",datelabel,sep=" "))
|
| 244 | 258 |
nb_point1<-paste("ns_obs=",length(data_s[[y_var_name]])-sum(is.na(data_s[[model_name]])),sep="")
|
| 245 | 259 |
nb_point2<-paste("nv_obs=",length(data_v[[y_var_name]])-sum(is.na(data_v[[model_name]])),sep="")
|
| 246 |
|
|
| 260 |
#Bug here |
|
| 247 | 261 |
rmse_str1<-paste("RMSE= ",format(rmse,digits=3),sep="")
|
| 248 | 262 |
rmse_str2<-paste("RMSE_f= ",format(rmse_f,digits=3),sep="")
|
| 249 | 263 |
|
| ... | ... | |
| 281 | 295 |
title(paste("Daily stations ", datelabel,sep=""))
|
| 282 | 296 |
nb_point1<-paste("ns_obs=",nrow(data_s),sep="")
|
| 283 | 297 |
nb_point2<-paste("nv_obs=",nrow(data_v),sep="")
|
| 298 |
#Bug here |
|
| 284 | 299 |
legend("bottomright",legend=c(nb_point1,nb_point2),bty="n",cex=0.8)
|
| 285 | 300 |
|
| 286 | 301 |
dev.off() |
| ... | ... | |
| 323 | 338 |
clim_lf <- basename(as.character(clim_method_mod_obj[[mo]]$clim)) #list of daily prediction files with path included |
| 324 | 339 |
clim_lf <- file.path(in_path_tile,clim_lf) |
| 325 | 340 |
delta_lf <- basename(unlist(method_mod_obj[[index]]$delta)) |
| 326 |
delta_lf <- file.path(in_path,delta_lf) |
|
| 341 |
delta_lf <- file.path(in_path_tile,delta_lf)
|
|
| 327 | 342 |
}else{
|
| 328 | 343 |
clim_lf <- clim_method_mod_obj[[index]]$clim #list of monthly prediction files with path included |
| 329 | 344 |
delta_lf <- method_mod_obj[[index]]$delta |
Also available in: Unified diff
run5 assessment NEX part3: modifications of function script to analyze results of tiles