Revision c33e3ed0
Added by Benoit Parmentier about 8 years ago
climate/research/oregon/interpolation/global_product_assessment_part2.R | ||
---|---|---|
197 | 197 |
|
198 | 198 |
########### #################### |
199 | 199 |
|
200 |
|
|
201 |
#https://www.r-bloggers.com/animated-plots-with-r/ |
|
202 |
|
|
203 |
|
|
200 |
in_dir_mosaic <- "/data/project/layers/commons/NEX_data/climateLayers/out/reg6/mosaics/mosaic" |
|
201 |
## using predictions |
|
204 | 202 |
if(is.null(lf_raster)){ |
205 | 203 |
|
206 | 204 |
#pattern_str <- ".*.tif" |
... | ... | |
216 | 214 |
NAvalue(r_stack) |
217 | 215 |
plot(r_stack,y=6,zlim=c(-10000,10000)) #this is not rescaled |
218 | 216 |
#plot(r_stack,zlim=c(-50,50),col=matlab.like(255)) |
217 |
var_name <- "dailyTmax" |
|
218 |
debug(plot_and_animate_raster_time_series) |
|
219 | 219 |
|
220 |
#plot(r_mosaic_scaled,y=6,zlim=c(-50,50)) |
|
221 |
#plot(r_mosaic_scaled,zlim=c(-50,50),col=matlab.like(255)) |
|
222 |
|
|
223 |
#debug(extract_date) |
|
224 |
#test <- extract_date(6431,lf_mosaic_list,12) #extract item number 12 from the name of files to get the data |
|
225 |
#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)) |
|
226 |
lf_mosaic_list <- lf_raster |
|
227 |
list_dates_produced <- mclapply(1:2, |
|
228 |
FUN=extract_date, |
|
229 |
x=lf_mosaic_list, |
|
230 |
item_no=13, |
|
231 |
mc.preschedule=FALSE, |
|
232 |
mc.cores = 2) |
|
233 |
item_no <-13 |
|
234 |
list_dates_produced <- unlist(mclapply(1:length(lf_raster), |
|
235 |
FUN=extract_date, |
|
236 |
x=lf_raster, |
|
237 |
item_no=item_no, |
|
238 |
mc.preschedule=FALSE, |
|
239 |
mc.cores = num_cores)) |
|
240 |
|
|
241 |
list_dates_produced_date_val <- as.Date(strptime(list_dates_produced,"%Y%m%d")) |
|
242 |
month_str <- format(list_dates_produced_date_val, "%b") ## Month, char, abbreviated |
|
243 |
year_str <- format(list_dates_produced_date_val, "%Y") ## Year with century |
|
244 |
day_str <- as.numeric(format(list_dates_produced_date_val, "%d")) ## numeric month |
|
245 |
|
|
246 |
df_raster <- data.frame(lf=basename(lf_raster), |
|
247 |
date=list_dates_produced_date_val, |
|
248 |
month_str=month_str, |
|
249 |
year=year_str, |
|
250 |
day=day_str, |
|
251 |
dir=dirname(lf_mosaic_list)) |
|
252 |
|
|
253 |
df_raster_fname <- file.path(out_dir,paste0("df_raster_",out_suffix,".txt")) |
|
254 |
write.table(df_raster,file= df_raster_fname,sep=",",row.names = F) |
|
255 |
|
|
256 |
############### PART5: Make raster stack and display maps ############# |
|
257 |
#### Extract corresponding raster for given dates and plot |
|
258 |
|
|
220 |
metric_name <- "var_pred" #use RMSE if accuracy |
|
259 | 221 |
|
260 |
#function_product_assessment_part2_functions <- "global_product_assessment_part2_functions_10102016.R" |
|
261 |
#source(file.path(script_path,function_product_assessment_part2_functions)) #source all functions used in this script |
|
262 |
|
|
263 |
#NA_flag_val_mosaic <- -3399999901438340239948148078125514752.000 |
|
264 |
r_stack_subset <- subset(r_stack,1:11) |
|
265 |
l_dates <- list_dates_produced_date_val[1:11] |
|
266 |
|
|
267 |
#undebug(plot_raster_mosaic) |
|
268 |
zlim_val <- NULL |
|
269 |
list_param_plot_raster_mosaic <- list(l_dates,r_stack_subset,NA_flag_val,out_dir,out_suffix, |
|
270 |
region_name,variable_name, zlim_val) |
|
271 |
names(list_param_plot_raster_mosaic) <- c("l_dates","r_mosaiced_scaled","NA_flag_val_mosaic","out_dir","out_suffix", |
|
272 |
"region_name","variable_name","zlim_val") |
|
273 |
|
|
274 |
lf_mosaic_plot_fig <- lapply(1:2, |
|
275 |
FUN=plot_raster_mosaic, |
|
276 |
list_param=list_param_plot_raster_mosaic) |
|
277 |
|
|
278 |
### Now run for the full time series |
|
279 |
#13.26 Western time: start |
|
280 |
l_dates <- list_dates_produced_date_val |
|
281 |
r_stack_subset <- r_stack |
|
282 |
zlim_val <- NULL |
|
283 |
list_param_plot_raster_mosaic <- list(l_dates,r_stack_subset,NA_flag_val,out_dir,out_suffix, |
|
284 |
region_name,variable_name, zlim_val) |
|
285 |
names(list_param_plot_raster_mosaic) <- c("l_dates","r_mosaiced_scaled","NA_flag_val_mosaic","out_dir","out_suffix", |
|
286 |
"region_name","variable_name","zlim_val") |
|
287 |
|
|
288 |
lf_mosaic_plot_fig <- mclapply(1:length(l_dates[1:11]), |
|
289 |
FUN=plot_raster_mosaic, |
|
290 |
list_param=list_param_plot_raster_mosaic, |
|
291 |
mc.preschedule=FALSE, |
|
292 |
mc.cores = num_cores) |
|
293 |
##start at 14.12 |
|
294 |
##finished at 16.47 |
|
295 |
lf_mosaic_plot_fig <- mclapply(1:length(l_dates), |
|
296 |
FUN=plot_raster_mosaic, |
|
297 |
list_param=list_param_plot_raster_mosaic, |
|
298 |
mc.preschedule=FALSE, |
|
299 |
mc.cores = num_cores) |
|
300 |
|
|
301 |
if(is.null(zlim_val)){ |
|
302 |
out_suffix_movie <- paste("min_max_",out_suffix,sep="") |
|
303 |
}else{ |
|
304 |
zlim_val_str <- paste(zlim_val,sep="_",collapse="_") |
|
305 |
out_suffix_movie <- paste(zlim_val_str,"_",out_suffix,sep="") |
|
306 |
} |
|
307 |
#r_stack_subset <- subset(r_stack,1:11) |
|
308 |
#l_dates <- list_dates_produced_date_val[1:11] |
|
309 |
|
|
310 |
filenames_figures_mosaic_test <- "list_figures_animation_test_reg6.txt" |
|
311 |
|
|
312 |
write.table(unlist(lf_mosaic_plot_fig[1:11]),filenames_figures_mosaic_test,row.names = F,col.names = F,quote = F) |
|
313 |
|
|
314 |
filenames_figures_mosaic <- paste0("list_figures_animation_",out_suffix_movie,".txt") |
|
315 |
|
|
316 |
write.table(unlist(lf_mosaic_plot_fig),filenames_figures_mosaic,row.names = F,col.names = F,quote = F) |
|
317 |
|
|
318 |
#now generate movie with imageMagick |
|
319 |
frame_speed <- 60 |
|
320 |
animation_format <- ".gif" |
|
321 |
out_suffix_str <- out_suffix |
|
322 |
#started |
|
323 |
#debug(generate_animation_from_figures_fun) |
|
324 |
generate_animation_from_figures_fun(filenames_figures= filenames_figures_mosaic_test, |
|
325 |
frame_speed=frame_speed, |
|
326 |
format_file=animation_format, |
|
327 |
out_suffix=out_suffix_str, |
|
328 |
out_dir=out_dir, |
|
329 |
out_filename_figure_animation="test_reg6_animation.gif") |
|
330 |
|
|
331 |
generate_animation_from_figures_fun(filenames_figures= unlist(lf_mosaic_plot_fig[1:11]), |
|
332 |
frame_speed=frame_speed, |
|
333 |
format_file=animation_format, |
|
334 |
out_suffix=out_suffix_str, |
|
335 |
out_dir=out_dir, |
|
336 |
out_filename_figure_animation="test2_reg6_animation.gif") |
|
337 |
#started 17.36 Western time on Oct 10 and 18.18 |
|
338 |
generate_animation_from_figures_fun(filenames_figures= filenames_figures_mosaic, |
|
222 |
plot_and_animate_raster_time_series(lf_raster=lf_raster, |
|
223 |
NAvalue=NA_flag_val, |
|
224 |
item_no=13, |
|
225 |
region_name=region_name, |
|
226 |
var_name=var_name, |
|
227 |
metric_name=metric_name, |
|
339 | 228 |
frame_speed=frame_speed, |
340 |
format_file=animation_format, |
|
341 |
out_suffix=out_suffix_movie, |
|
342 |
out_dir=out_dir, |
|
343 |
out_filename_figure_animation=NULL) |
|
229 |
animation_format=animation_format, |
|
230 |
zlim_val=NULL, |
|
231 |
plot_figure=F, |
|
232 |
generate_animation=T, |
|
233 |
num_cores=num_cores, |
|
234 |
out_suffix=out_suffix, |
|
235 |
out_dir=out_dir) |
|
236 |
|
|
237 |
## Create function here: |
|
238 |
|
|
239 |
plot_and_animate_raster_time_series <- function(lf_raster,NAvalue, item_no,region_name,var_name,metric_name,frame_speed,animation_format,zlim_val,plot_figure,generate_animation,num_cores,out_suffix,out_dir){ |
|
240 |
#Function to generate figures and animation for a list of raster |
|
241 |
# |
|
242 |
# |
|
243 |
#INPUTS |
|
244 |
#1) lf_raster, |
|
245 |
#2) NAvalue |
|
246 |
#3) item_no |
|
247 |
#4) region_name, |
|
248 |
#5) var_name |
|
249 |
#6) metric_name |
|
250 |
#7) frame_speed |
|
251 |
#8) animation_format |
|
252 |
#9) zlim_val |
|
253 |
#10) plot_figure |
|
254 |
#11) generate_animation |
|
255 |
#12) num_cores |
|
256 |
#13) out_suffix |
|
257 |
#14) out_dir |
|
258 |
#OUTPUTS |
|
259 |
# |
|
260 |
# |
|
261 |
|
|
262 |
lf_mosaic_list <- lf_raster |
|
263 |
variable_name <- var_name |
|
264 |
|
|
265 |
if(plot_figure==T){ |
|
266 |
#item_no <- 13 |
|
267 |
list_dates_produced <- unlist(mclapply(1:length(lf_raster), |
|
268 |
FUN = extract_date, |
|
269 |
x = lf_raster, |
|
270 |
item_no = item_no, |
|
271 |
mc.preschedule = FALSE, |
|
272 |
mc.cores = num_cores)) |
|
273 |
|
|
274 |
list_dates_produced_date_val <- as.Date(strptime(list_dates_produced, "%Y%m%d")) |
|
275 |
month_str <- format(list_dates_produced_date_val, "%b") ## Month, char, abbreviated |
|
276 |
year_str <- format(list_dates_produced_date_val, "%Y") ## Year with century |
|
277 |
day_str <- as.numeric(format(list_dates_produced_date_val, "%d")) ## numeric month |
|
278 |
df_raster <- data.frame(lf = basename(lf_raster), |
|
279 |
date = list_dates_produced_date_val, |
|
280 |
month_str = month_str, |
|
281 |
year = year_str, |
|
282 |
day = day_str, |
|
283 |
dir = dirname(lf_mosaic_list)) |
|
284 |
|
|
285 |
df_raster_fname <- file.path(out_dir, paste0("df_raster_", out_suffix, ".txt")) |
|
286 |
write.table(df_raster,file = df_raster_fname,sep = ",",row.names = F) |
|
287 |
|
|
288 |
############### PART5: Make raster stack and display maps ############# |
|
289 |
#### Extract corresponding raster for given dates and plot |
|
290 |
|
|
291 |
r_stack_subset <- subset(r_stack, 1:11) |
|
292 |
l_dates <- list_dates_produced_date_val[1:11] |
|
293 |
|
|
294 |
#undebug(plot_raster_mosaic) |
|
295 |
zlim_val <- NULL |
|
296 |
|
|
297 |
### Now run for the full time series |
|
298 |
#13.26 Western time: start |
|
299 |
l_dates <- list_dates_produced_date_val |
|
300 |
r_stack_subset <- r_stack |
|
301 |
zlim_val <- NULL |
|
302 |
list_param_plot_raster_mosaic <- list(l_dates,r_stack_subset,NA_flag_val,out_dir, |
|
303 |
out_suffix,region_name,variable_name,zlim_val) |
|
304 |
names(list_param_plot_raster_mosaic) <- c("l_dates","r_mosaiced_scaled","NA_flag_val_mosaic","out_dir", |
|
305 |
"out_suffix", "region_name","variable_name","zlim_val") |
|
306 |
|
|
307 |
lf_mosaic_plot_fig <- mclapply(1:length(l_dates[1:11]), |
|
308 |
FUN = plot_raster_mosaic, |
|
309 |
list_param = list_param_plot_raster_mosaic, |
|
310 |
mc.preschedule = FALSE, |
|
311 |
mc.cores = num_cores) |
|
312 |
##start at 14.12 |
|
313 |
##finished at 16.47 |
|
314 |
lf_mosaic_plot_fig <- mclapply(1:length(l_dates), |
|
315 |
FUN = plot_raster_mosaic, |
|
316 |
list_param = list_param_plot_raster_mosaic, |
|
317 |
mc.preschedule = FALSE, |
|
318 |
mc.cores = num_cores) |
|
319 |
|
|
320 |
} |
|
321 |
|
|
322 |
### Part 2 generate movie |
|
323 |
|
|
324 |
if(generate_animation==TRUE){ |
|
325 |
|
|
326 |
if (is.null(zlim_val)) { |
|
327 |
out_suffix_movie <- paste("min_max_", out_suffix, sep = "") |
|
328 |
} else{ |
|
329 |
zlim_val_str <- paste(zlim_val, sep = "_", collapse = "_") |
|
330 |
out_suffix_movie <- paste(zlim_val_str, "_", out_suffix, sep = "") |
|
331 |
} |
|
332 |
#r_stack_subset <- subset(r_stack,1:11) |
|
333 |
#l_dates <- list_dates_produced_date_val[1:11] |
|
334 |
|
|
335 |
filenames_figures_mosaic <- paste0("list_figures_animation_", out_suffix_movie, ".txt") |
|
336 |
|
|
337 |
write.table(unlist(lf_mosaic_plot_fig),filenames_figures_mosaic,row.names = F,col.names = F,quote = F) |
|
338 |
|
|
339 |
#now generate movie with imageMagick |
|
340 |
#frame_speed <- 60 |
|
341 |
#animation_format <- ".gif" |
|
342 |
out_suffix_str <- out_suffix |
|
343 |
#started |
|
344 |
#debug(generate_animation_from_figures_fun) |
|
345 |
|
|
346 |
out_filename_figure_animation <- generate_animation_from_figures_fun(filenames_figures = unlist(lf_mosaic_plot_fig[1:11]), |
|
347 |
frame_speed = frame_speed, |
|
348 |
format_file = animation_format, |
|
349 |
out_suffix = out_suffix_str, |
|
350 |
out_dir = out_dir, |
|
351 |
out_filename_figure_animation = "test2_reg6_animation.gif") |
|
352 |
|
|
353 |
#started 17.36 Western time on Oct 10 and 18.18 |
|
354 |
out_filename_figure_animation <- generate_animation_from_figures_fun(filenames_figures = filenames_figures_mosaic, |
|
355 |
frame_speed = frame_speed, |
|
356 |
format_file = animation_format, |
|
357 |
out_suffix = out_suffix_movie, |
|
358 |
out_dir = out_dir, |
|
359 |
out_filename_figure_animation = NULL) |
|
360 |
} |
|
361 |
|
|
362 |
## prepare object to return |
|
363 |
|
|
364 |
figure_animation_obj <- list(filenames_figures_mosaic,out_filename_figure_animation) |
|
365 |
names(figure_animation_obj) <- c("filenames_figures_mosaic","out_filename_figure_animation") |
|
366 |
return(figure_animation_obj) |
|
344 | 367 |
|
368 |
} |
|
345 | 369 |
|
346 | 370 |
############ Now accuracy |
347 | 371 |
#### PLOT ACCURACY METRICS: First test #### |
Also available in: Unified diff
adding new function to plot and generate animation for list of raster files or figures