Project

General

Profile

« Previous | Next » 

Revision c33e3ed0

Added by Benoit Parmentier about 8 years ago

adding new function to plot and generate animation for list of raster files or figures

View differences:

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