Revision 3e850c62
Added by Benoit Parmentier about 8 years ago
| climate/research/oregon/interpolation/global_product_assessment_part2.R | ||
|---|---|---|
| 254 | 254 |
write.table(df_raster,file= df_raster_fname,sep=",",row.names = F) |
| 255 | 255 |
|
| 256 | 256 |
############### PART5: Make raster stack and display maps ############# |
| 257 |
#### Extract corresponding raster for given dates and plot stations used
|
|
| 257 |
#### Extract corresponding raster for given dates and plot |
|
| 258 | 258 |
|
| 259 |
## TODO: make movies from time series in png |
|
| 260 |
|
|
| 261 |
#start_date <- day_to_mosaic_range[1] |
|
| 262 |
#end_date <- day_to_mosaic_range[2] |
|
| 263 |
#start_date <- day_start #PARAM 12 arg 12 |
|
| 264 |
#end_date <- day_end #PARAM 13 arg 13 |
|
| 265 |
|
|
| 266 |
#date_to_plot <- seq(as.Date(strptime(start_date,"%Y%m%d")), as.Date(strptime(end_date,"%Y%m%d")), 'day') |
|
| 267 |
#l_dates <- format(date_to_plot,"%Y%m%d") #format back to the relevant date format for files |
|
| 268 |
#mask_pred <- FALSE |
|
| 269 |
#matching <- FALSE #to be added after mask_pred option |
|
| 270 |
#list_param_pre_process <- list(raster_name_lf,python_bin,infile_mask,scaling,mask_pred,NA_flag_val,out_suffix,out_dir) |
|
| 271 |
#names(list_param_pre_process) <- c("lf","python_bin","infile_mask","scaling","mask_pred","NA_flag_val","out_suffix","out_dir")
|
|
| 272 |
|
|
| 273 |
#debug(pre_process_raster_mosaic_fun) |
|
| 274 |
|
|
| 275 |
#lf_mosaic_scaled <- mclapply(1:length(raster_name_lf),FUN=pre_process_raster_mosaic_fun,list_param=list_param_pre_process,mc.preschedule=FALSE,mc.cores = num_cores) |
|
| 276 |
#lf_mosaic_scaled <- mclapply(1:length(raster_name_lf),FUN=pre_process_raster_mosaic_fun,list_param=list_param_pre_process,mc.preschedule=FALSE,mc.cores = num_cores) |
|
| 277 |
|
|
| 278 |
#test <- pre_process_raster_mosaic_fun(2,list_param_pre_process) |
|
| 279 |
#lf_mosaic_scaled <- unlist(lf_mosaic_scaled) |
|
| 280 |
|
|
| 281 |
##################################### PART 5 ###### |
|
| 282 |
##### Plotting specific days for the mosaics |
|
| 283 | 259 |
|
| 284 | 260 |
#function_product_assessment_part2_functions <- "global_product_assessment_part2_functions_10102016.R" |
| 285 | 261 |
#source(file.path(script_path,function_product_assessment_part2_functions)) #source all functions used in this script |
| ... | ... | |
| 371 | 347 |
#### PLOT ACCURACY METRICS: First test #### |
| 372 | 348 |
##this will be cleaned up later: |
| 373 | 349 |
|
| 350 |
in_dir_mosaic_RMSE <- "/data/project/layers/commons/NEX_data/climateLayers/out/reg6/mosaicsRMSE/mosaic" |
|
| 374 | 351 |
pattern_str <-"*.tif" |
| 375 | 352 |
in_dir_mosaic <- in_dir_mosaic_RMSE |
| 376 | 353 |
lf_raster_rmse <- list.files(path=in_dir_mosaic,pattern=pattern_str,recursive=F,full.names=T) |
| 354 |
lf_raster <- lf_raster_rmse |
|
| 377 | 355 |
r_stack <- stack(lf_raster,quick=T) #this is very fast now with the quick option! |
| 378 |
#save(r_mosaic,file="r_mosaic.RData")
|
|
| 356 |
#save(r_mosaic,file="r_mosaic.RData") |
|
| 379 | 357 |
|
| 380 | 358 |
NAvalue(r_stack) |
| 381 |
plot(r_stack,y=6,zlim=c(-10000,10000)) #this is not rescaled |
|
| 382 |
#plot(r_stack,zlim=c(-50,50),col=matlab.like(255)) |
|
| 383 |
|
|
| 384 |
#plot(r_mosaic_scaled,y=6,zlim=c(-50,50)) |
|
| 385 |
#plot(r_mosaic_scaled,zlim=c(-50,50),col=matlab.like(255)) |
|
| 359 |
plot(r_stack,y=6,zlim=c(0,8000)) #this is not rescaled |
|
| 386 | 360 |
|
| 387 |
#debug(extract_date) |
|
| 388 |
#test <- extract_date(6431,lf_mosaic_list,12) #extract item number 12 from the name of files to get the data |
|
| 389 |
#list_dates_produced <- unlist(mclapply(1:length(lf_raster),FUN=extract_date,x=lf_raster,item_no=13,mc.preschedule=FALSE,mc.cores = num_cores)) |
|
| 390 | 361 |
lf_mosaic_list <- lf_raster |
| 391 |
list_dates_produced <- mclapply(1:2, |
|
| 362 |
list_dates_produced_RMSE <- mclapply(1:2,
|
|
| 392 | 363 |
FUN=extract_date, |
| 393 | 364 |
x=lf_mosaic_list, |
| 394 |
item_no=13,
|
|
| 365 |
item_no=15,
|
|
| 395 | 366 |
mc.preschedule=FALSE, |
| 396 | 367 |
mc.cores = 2) |
| 397 |
item_no <-13
|
|
| 398 |
list_dates_produced <- unlist(mclapply(1:length(lf_raster), |
|
| 368 |
item_no <-15
|
|
| 369 |
list_dates_produced_RMSE <- unlist(mclapply(1:length(lf_raster),
|
|
| 399 | 370 |
FUN=extract_date, |
| 400 | 371 |
x=lf_raster, |
| 401 | 372 |
item_no=item_no, |
| 402 | 373 |
mc.preschedule=FALSE, |
| 403 | 374 |
mc.cores = num_cores)) |
| 404 | 375 |
|
| 405 |
list_dates_produced_date_val <- as.Date(strptime(list_dates_produced,"%Y%m%d")) |
|
| 376 |
list_dates_produced_date_val <- as.Date(strptime(list_dates_produced_RMSE,"%Y%m%d"))
|
|
| 406 | 377 |
month_str <- format(list_dates_produced_date_val, "%b") ## Month, char, abbreviated |
| 407 | 378 |
year_str <- format(list_dates_produced_date_val, "%Y") ## Year with century |
| 408 | 379 |
day_str <- as.numeric(format(list_dates_produced_date_val, "%d")) ## numeric month |
| 409 | 380 |
|
| 410 |
df_raster <- data.frame(lf=basename(lf_raster), |
|
| 381 |
df_raster_rmse <- data.frame(lf=basename(lf_raster),
|
|
| 411 | 382 |
date=list_dates_produced_date_val, |
| 412 | 383 |
month_str=month_str, |
| 413 | 384 |
year=year_str, |
| 414 | 385 |
day=day_str, |
| 415 | 386 |
dir=dirname(lf_mosaic_list)) |
| 416 | 387 |
|
| 417 |
df_raster_fname <- file.path(out_dir,paste0("df_raster_",out_suffix,".txt"))
|
|
| 388 |
df_raster_fname <- file.path(out_dir,paste0("df_raster_rmse",out_suffix,".txt"))
|
|
| 418 | 389 |
write.table(df_raster,file= df_raster_fname,sep=",",row.names = F) |
| 419 | 390 |
|
| 391 |
|
|
| 392 |
r_stack_subset <- subset(r_stack,1:11) |
|
| 393 |
l_dates <- list_dates_produced_date_val[1:11] |
|
| 394 |
|
|
| 395 |
#undebug(plot_raster_mosaic) |
|
| 396 |
out_suffix_str <- paste0("rmse_",out_suffix)
|
|
| 397 |
|
|
| 398 |
zlim_val <- NULL |
|
| 399 |
##Need to add title option!! |
|
| 400 |
list_param_plot_raster_mosaic <- list(l_dates,r_stack_subset,NA_flag_val,out_dir,out_suffix_str, |
|
| 401 |
region_name,variable_name, zlim_val) |
|
| 402 |
names(list_param_plot_raster_mosaic) <- c("l_dates","r_mosaiced_scaled","NA_flag_val_mosaic","out_dir","out_suffix",
|
|
| 403 |
"region_name","variable_name","zlim_val") |
|
| 404 |
lf_mosaic_plot_fig <- lapply(1:2, |
|
| 405 |
FUN=plot_raster_mosaic, |
|
| 406 |
list_param=list_param_plot_raster_mosaic) |
|
| 407 |
|
|
| 408 |
### Now run for the full time series |
|
| 409 |
#13.26 Western time: start |
|
| 410 |
l_dates <- list_dates_produced_date_val |
|
| 411 |
r_stack_subset <- r_stack |
|
| 412 |
zlim_val <- NULL |
|
| 413 |
list_param_plot_raster_mosaic <- list(l_dates,r_stack_subset,NA_flag_val,out_dir,out_suffix, |
|
| 414 |
region_name,variable_name, zlim_val) |
|
| 415 |
names(list_param_plot_raster_mosaic) <- c("l_dates","r_mosaiced_scaled","NA_flag_val_mosaic","out_dir","out_suffix",
|
|
| 416 |
"region_name","variable_name","zlim_val") |
|
| 417 |
#started at 20.16 on 10/10/2016, finished 22.39 |
|
| 418 |
lf_mosaic_plot_fig <- mclapply(1:length(l_dates), |
|
| 419 |
FUN=plot_raster_mosaic, |
|
| 420 |
list_param=list_param_plot_raster_mosaic, |
|
| 421 |
mc.preschedule=FALSE, |
|
| 422 |
mc.cores = num_cores) |
|
| 423 |
|
|
| 424 |
|
|
| 425 |
if(is.null(zlim_val)){
|
|
| 426 |
out_suffix_movie <- paste("min_max_",out_suffix,sep="")
|
|
| 427 |
}else{
|
|
| 428 |
zlim_val_str <- paste(zlim_val,sep="_",collapse="_") |
|
| 429 |
out_suffix_movie <- paste(zlim_val_str,"_",out_suffix,sep="") |
|
| 430 |
} |
|
| 431 |
#r_stack_subset <- subset(r_stack,1:11) |
|
| 432 |
#l_dates <- list_dates_produced_date_val[1:11] |
|
| 433 |
|
|
| 434 |
filenames_figures_mosaic_test <- "list_figures_animation_test_reg6.txt" |
|
| 435 |
|
|
| 436 |
write.table(unlist(lf_mosaic_plot_fig[1:11]),filenames_figures_mosaic_test,row.names = F,col.names = F,quote = F) |
|
| 437 |
|
|
| 438 |
filenames_figures_mosaic <- paste0("list_figures_animation_",out_suffix_movie,".txt")
|
|
| 439 |
|
|
| 440 |
write.table(unlist(lf_mosaic_plot_fig),filenames_figures_mosaic,row.names = F,col.names = F,quote = F) |
|
| 441 |
|
|
| 442 |
#now generate movie with imageMagick |
|
| 443 |
frame_speed <- 60 |
|
| 444 |
animation_format <- ".gif" |
|
| 445 |
out_suffix_str <- out_suffix |
|
| 446 |
out_suffix_movie <- paste0("rmse_",out_suffix_movie)
|
|
| 447 |
#started: |
|
| 448 |
|
|
| 449 |
generate_animation_from_figures_fun(filenames_figures= unlist(lf_mosaic_plot_fig[1:11]), |
|
| 450 |
frame_speed=frame_speed, |
|
| 451 |
format_file=animation_format, |
|
| 452 |
out_suffix=out_suffix_str, |
|
| 453 |
out_dir=out_dir, |
|
| 454 |
out_filename_figure_animation="test2_reg6_animation.gif") |
|
| 455 |
#started 6.43 Western time on Oct 11 and 7.19 |
|
| 456 |
generate_animation_from_figures_fun(filenames_figures= filenames_figures_mosaic, |
|
| 457 |
frame_speed=frame_speed, |
|
| 458 |
format_file=animation_format, |
|
| 459 |
out_suffix=out_suffix_movie, |
|
| 460 |
out_dir=out_dir, |
|
| 461 |
out_filename_figure_animation=NULL) |
|
| 462 |
|
|
| 420 | 463 |
############################ END OF SCRIPT ################################## |
Also available in: Unified diff
testing animation function for RMSE mosaics