Revision 023c1024
Added by Benoit Parmentier about 8 years ago
climate/research/oregon/interpolation/global_product_assessment_part2_functions.R | ||
---|---|---|
297 | 297 |
|
298 | 298 |
} |
299 | 299 |
|
300 |
|
|
301 |
plot_and_animate_raster_time_series <- function(lf_raster, item_no,region_name,var_name,metric_name,NA_flag_val,filenames_figures=NULL,frame_speed=60,animation_format=".gif",zlim_val=NULL,plot_figure=T,generate_animation=T,num_cores=2,out_suffix="",out_dir="."){ |
|
302 |
#Function to generate figures and animation for a list of raster |
|
303 |
# |
|
304 |
# |
|
305 |
#INPUTS |
|
306 |
#1) lf_raster |
|
307 |
#2) filenames_figures |
|
308 |
#2) NAvalue |
|
309 |
#3) item_no |
|
310 |
#4) region_name, |
|
311 |
#5) var_name |
|
312 |
#6) metric_name |
|
313 |
#7) frame_speed |
|
314 |
#8) animation_format |
|
315 |
#9) zlim_val |
|
316 |
#10) plot_figure |
|
317 |
#11) generate_animation |
|
318 |
#12) num_cores |
|
319 |
#13) out_suffix |
|
320 |
#14) out_dir |
|
321 |
#OUTPUTS |
|
322 |
# |
|
323 |
# |
|
324 |
|
|
325 |
|
|
326 |
|
|
327 |
#lf_mosaic_list <- lf_raster |
|
328 |
variable_name <- var_name |
|
329 |
|
|
330 |
if(!is.null(plot_figure)){ |
|
331 |
#item_no <- 13 |
|
332 |
list_dates_produced <- unlist(mclapply(1:length(lf_raster), |
|
333 |
FUN = extract_date, |
|
334 |
x = lf_raster, |
|
335 |
item_no = item_no, |
|
336 |
mc.preschedule = FALSE, |
|
337 |
mc.cores = num_cores)) |
|
338 |
|
|
339 |
list_dates_produced_date_val <- as.Date(strptime(list_dates_produced, "%Y%m%d")) |
|
340 |
month_str <- format(list_dates_produced_date_val, "%b") ## Month, char, abbreviated |
|
341 |
year_str <- format(list_dates_produced_date_val, "%Y") ## Year with century |
|
342 |
day_str <- as.numeric(format(list_dates_produced_date_val, "%d")) ## numeric month |
|
343 |
df_raster <- data.frame(lf = basename(lf_raster), |
|
344 |
date = list_dates_produced_date_val, |
|
345 |
month_str = month_str, |
|
346 |
year = year_str, |
|
347 |
day = day_str, |
|
348 |
dir = dirname(lf_raster)) |
|
349 |
|
|
350 |
df_raster_fname <- file.path(out_dir, paste0("df_raster_", out_suffix, ".txt")) |
|
351 |
write.table(df_raster,file = df_raster_fname,sep = ",",row.names = F) |
|
352 |
|
|
353 |
############### PART5: Make raster stack and display maps ############# |
|
354 |
#### Extract corresponding raster for given dates and plot |
|
355 |
|
|
356 |
r_stack <- stack(lf_raster,quick=T) |
|
357 |
l_dates <- list_dates_produced_date_val #[1:11] |
|
358 |
|
|
359 |
#undebug(plot_raster_mosaic) |
|
360 |
zlim_val <- zlim_val |
|
361 |
|
|
362 |
### Now run for the full time series |
|
363 |
#13.26 Western time: start |
|
364 |
#l_dates <- list_dates_produced_date_val |
|
365 |
#r_stack_subset <- r_stack |
|
366 |
#zlim_val <- NULL |
|
367 |
out_suffix_str <- paste0(var_name,"_",metric_name,"_",out_suffix) |
|
368 |
list_param_plot_raster_mosaic <- list(l_dates,r_stack,NA_flag_val,out_dir, |
|
369 |
out_suffix_str,region_name,variable_name,zlim_val) |
|
370 |
names(list_param_plot_raster_mosaic) <- c("l_dates","r_mosaiced_scaled","NA_flag_val_mosaic","out_dir", |
|
371 |
"out_suffix", "region_name","variable_name","zlim_val") |
|
372 |
|
|
373 |
#lf_mosaic_plot_fig <- mclapply(1:length(l_dates[1:11]), |
|
374 |
# FUN = plot_raster_mosaic, |
|
375 |
# list_param = list_param_plot_raster_mosaic, |
|
376 |
# mc.preschedule = FALSE, |
|
377 |
# mc.cores = num_cores) |
|
378 |
|
|
379 |
##start at 12.29 |
|
380 |
##finished at 15.23 (for reg 6 with 2,991 figures) |
|
381 |
lf_mosaic_plot_fig <- mclapply(1:length(l_dates), |
|
382 |
FUN = plot_raster_mosaic, |
|
383 |
list_param = list_param_plot_raster_mosaic, |
|
384 |
mc.preschedule = FALSE, |
|
385 |
mc.cores = num_cores) |
|
386 |
|
|
387 |
if (is.null(zlim_val)) { |
|
388 |
out_suffix_movie <- paste("min_max_", out_suffix_str, sep = "") |
|
389 |
} else{ |
|
390 |
zlim_val_str <- paste(zlim_val, sep = "_", collapse = "_") |
|
391 |
out_suffix_movie <- paste(zlim_val_str, "_", out_suffix, sep = "") |
|
392 |
} |
|
393 |
filenames_figures_mosaic <- paste0("list_figures_animation_", out_suffix_movie, ".txt") |
|
394 |
|
|
395 |
write.table(unlist(lf_mosaic_plot_fig),filenames_figures_mosaic,row.names = F,col.names = F,quote = F) |
|
396 |
|
|
397 |
} |
|
398 |
|
|
399 |
### Part 2 generate movie |
|
400 |
|
|
401 |
if(generate_animation==TRUE){ |
|
402 |
|
|
403 |
out_suffix_str <- paste0(var_name,"_",metric_name,"_",out_suffix) |
|
404 |
|
|
405 |
if (is.null(zlim_val)) { |
|
406 |
out_suffix_movie <- paste("min_max_", out_suffix, sep = "") |
|
407 |
} else{ |
|
408 |
zlim_val_str <- paste(zlim_val, sep = "_", collapse = "_") |
|
409 |
out_suffix_movie <- paste(zlim_val_str, "_", out_suffix, sep = "") |
|
410 |
} |
|
411 |
|
|
412 |
#already provided as a parameter |
|
413 |
#filenames_figures_mosaic <- paste0("list_figures_animation_", out_suffix_movie, ".txt") |
|
414 |
#write.table(unlist(lf_mosaic_plot_fig),filenames_figures_mosaic,row.names = F,col.names = F,quote = F) |
|
415 |
|
|
416 |
#now generate movie with imageMagick |
|
417 |
#frame_speed <- 60 |
|
418 |
#animation_format <- ".gif" |
|
419 |
#out_suffix_str <- out_suffix |
|
420 |
#started |
|
421 |
#debug(generate_animation_from_figures_fun) |
|
422 |
#lf_mosaic_plot_fig <- read.table(filenames_figure,sep=",") |
|
423 |
|
|
424 |
#out_filename_figure_animation <- generate_animation_from_figures_fun(filenames_figures = unlist(lf_mosaic_plot_fig[1:11]), |
|
425 |
# frame_speed = frame_speed, |
|
426 |
# format_file = animation_format, |
|
427 |
# out_suffix = out_suffix_str, |
|
428 |
# out_dir = out_dir, |
|
429 |
# out_filename_figure_animation = "test2_reg6_animation.gif") |
|
430 |
|
|
431 |
#started 17.36 Western time on Oct 10 and 18.18 |
|
432 |
# 15.58 oct 11 for 16.38 for reg6 pred (about 2991) |
|
433 |
out_filename_figure_animation <- generate_animation_from_figures_fun(filenames_figures = filenames_figures_mosaic, |
|
434 |
frame_speed = frame_speed, |
|
435 |
format_file = animation_format, |
|
436 |
out_suffix = out_suffix_movie, |
|
437 |
out_dir = out_dir, |
|
438 |
out_filename_figure_animation = NULL) |
|
439 |
} |
|
440 |
|
|
441 |
## prepare object to return |
|
442 |
|
|
443 |
figure_animation_obj <- list(filenames_figures_mosaic,out_filename_figure_animation) |
|
444 |
names(figure_animation_obj) <- c("filenames_figures_mosaic","out_filename_figure_animation") |
|
445 |
return(figure_animation_obj) |
|
446 |
|
|
447 |
} |
|
448 |
|
|
300 | 449 |
############################ END OF SCRIPT ################################## |
Also available in: Unified diff
adding plot animate raster time series in function script