Revision 156b5e38
Added by Benoit Parmentier over 9 years ago
climate/research/oregon/interpolation/global_run_scalingup_mosaicing.R | ||
---|---|---|
5 | 5 |
#Analyses, figures, tables and data are also produced in the script. |
6 | 6 |
#AUTHOR: Benoit Parmentier |
7 | 7 |
#CREATED ON: 04/14/2015 |
8 |
#MODIFIED ON: 05/08/2015
|
|
8 |
#MODIFIED ON: 05/11/2015
|
|
9 | 9 |
#Version: 4 |
10 | 10 |
#PROJECT: Environmental Layers project |
11 | 11 |
#COMMENTS: analyses for run 10 global analyses,all regions 1500x4500km and other tiles |
... | ... | |
238 | 238 |
max_val <- cellStats(r_dist,max) |
239 | 239 |
r_dist_normalized <- abs(r_dist - max_val)/ (max_val - min_val) |
240 | 240 |
|
241 |
extension_str <- extension(lf_mosaic_pred_1500x4500[i])
|
|
242 |
raster_name_tmp <- gsub(extension_str,"",basename(lf_mosaic_pred_1500x4500[i]))
|
|
241 |
extension_str <- extension(lf[i]) |
|
242 |
raster_name_tmp <- gsub(extension_str,"",basename(lf[i])) |
|
243 | 243 |
raster_name <- file.path(out_dir_str,paste(raster_name_tmp,"_weights.tif",sep="")) |
244 | 244 |
writeRaster(r_dist_normalized, NAflag=NA_flag_val,filename=raster_name,overwrite=TRUE) |
245 | 245 |
|
246 | 246 |
r_var_prod <- r1*r_dist_normalized |
247 |
raster_name_prod <- file.path(out_dir_str, paste(raster_name_tmp,"_prod_weights.tif")) |
|
247 |
raster_name_prod <- file.path(out_dir_str, paste(raster_name_tmp,"_prod_weights.tif",sep=""))
|
|
248 | 248 |
writeRaster(r_var_prod, NAflag=NA_flag_val,filename=raster_name_prod,overwrite=TRUE) |
249 | 249 |
|
250 | 250 |
weights_obj <- list(raster_name,raster_name_prod) |
... | ... | |
375 | 375 |
|
376 | 376 |
r1 <- raster(lf_mosaic_pred_1500x4500[1]) |
377 | 377 |
r2 <- raster(lf_mosaic_pred_1500x4500[2]) |
378 |
r5 |
|
378 |
|
|
379 | 379 |
plot(r1) |
380 | 380 |
plot(r2) |
381 | 381 |
|
... | ... | |
413 | 413 |
#list_args_weights_prod <- lapply(1:length(weights_obj_list), FUN=function(x){raster(x[[i]]$r_weights_prod})} |
414 | 414 |
#list_args_weights_prod$fun <- "sum" |
415 | 415 |
|
416 |
|
|
417 | 416 |
#"r_weights","r_weights_prod" |
418 | 417 |
|
419 | 418 |
#list_r_weights <- lapply(1:length(weights_obj_list), FUN=function(i,x){raster(x[[i]]$r_weights)},x=weights_obj_list) |
... | ... | |
422 | 421 |
list_r_weights <- lapply(1:length(weights_obj_list), FUN=function(i,x){x[[i]]$r_weights},x=weights_obj_list) |
423 | 422 |
list_r_weights_prod <- lapply(1:length(weights_obj_list), FUN=function(i,x){x[[i]]$r_weights_prod},x=weights_obj_list) |
424 | 423 |
|
425 |
|
|
426 |
|
|
427 | 424 |
#r_weights_sum <- do.call(overlay,list_args_weights) #sum |
428 | 425 |
#r_weights_sum <- do.call(overlay,list_args_weights) #sum |
429 | 426 |
|
... | ... | |
447 | 444 |
#r_weights_sum <- ... |
448 | 445 |
#r_val_w_sum <- |
449 | 446 |
# |
450 |
mosaic_list_var <- list(list_r_weights) |
|
451 |
mosaic_list_var <- list(lf_mosaic_pred_1500x4500) |
|
447 |
#mosaic_list_var <- list(list_r_weights)
|
|
448 |
#mosaic_list_var <- list(lf_mosaic_pred_1500x4500)
|
|
452 | 449 |
#out_rastnames_var <- l_out_rastnames_var[[i]] |
453 |
out_rastnames_var <- c("reg1_mosaic_mean.tif") |
|
450 |
#out_rastnames_var <- c("reg1_mosaic_mean.tif")
|
|
454 | 451 |
|
455 | 452 |
#list_param_mosaic <- list(list_r_weights,out_dir,outrastnames,file_format,NA_flag_val,out_suffix) |
456 | 453 |
|
457 |
file_format <- ".tif" |
|
458 |
NA_flag_val <- -9999 |
|
454 |
#file_format <- ".tif"
|
|
455 |
#NA_flag_val <- -9999
|
|
459 | 456 |
|
460 |
j<-1 #date index for loop |
|
461 |
list_param_mosaic<-list(j,mosaic_list_var,out_rastnames_var,out_dir,file_format,NA_flag_val) |
|
462 |
names(list_param_mosaic)<-c("j","mosaic_list","out_rastnames","out_path","file_format","NA_flag_val") |
|
457 |
#j<-1 #date index for loop
|
|
458 |
#list_param_mosaic<-list(j,mosaic_list_var,out_rastnames_var,out_dir,file_format,NA_flag_val)
|
|
459 |
#names(list_param_mosaic)<-c("j","mosaic_list","out_rastnames","out_path","file_format","NA_flag_val")
|
|
463 | 460 |
#undebug(mosaic_m_raster_list) |
464 |
r_mosaiced <- mosaic_m_raster_list(1,list_param_mosaic) |
|
461 |
#r_mosaiced <- mosaic_m_raster_list(1,list_param_mosaic)
|
|
465 | 462 |
|
466 | 463 |
|
467 | 464 |
#list_var_mosaiced <- mclapply(1:2,FUN=mosaic_m_raster_list,list_param=list_param_mosaic,mc.preschedule=FALSE,mc.cores = 2) |
468 |
list_var_mosaiced <- mclapply(1,FUN=mosaic_m_raster_list,list_param=list_param_mosaic,mc.preschedule=FALSE,mc.cores = 1) |
|
465 |
#list_var_mosaiced <- mclapply(1,FUN=mosaic_m_raster_list,list_param=list_param_mosaic,mc.preschedule=FALSE,mc.cores = 1)
|
|
469 | 466 |
#list_var_mosaiced <- mclapply(1:1,FUN=mosaic_m_raster_list,list_param=list_param_mosaic,mc.preschedule=FALSE,mc.cores = 1) |
470 | 467 |
#list_var_mosaiced <- mclapply(1:365,FUN=mosaic_m_raster_list,list_param=list_param_mosaic,mc.preschedule=FALSE,mc.cores = 2) |
471 | 468 |
|
... | ... | |
478 | 475 |
cmd_str <- paste("python","/usr/bin/gdal_merge.py","-o avg.tif",paste(lf_mosaic_pred_1500x4500,collapse=" ")) |
479 | 476 |
system(cmd_str) |
480 | 477 |
|
478 |
##Create raster image for weights matching resolution and extent to the mosaic |
|
481 | 479 |
lf_files <- list_r_weights |
482 | 480 |
r_m <- raster("avg.tif") |
483 | 481 |
|
484 | 482 |
for (i in 1:length(lf_files)){ |
485 | 483 |
set1f <- function(x){rep(NA, x)} |
486 |
r_ref <- init(r_m, fun=set1f, filename=paste('r_weigts_m_',i,'.tif',sep=""), overwrite=TRUE) |
|
484 |
r_ref <- init(r_m, fun=set1f, filename=paste('r_weights_m_',i,'.tif',sep=""), overwrite=TRUE)
|
|
487 | 485 |
#NAvalue(r_ref) <- -9999 |
488 | 486 |
|
489 | 487 |
cmd_str <- paste("/usr/bin/gdalwarp",list_r_weights[[i]],paste('r_weights_m_',i,'.tif',sep=""),sep=" ") |
... | ... | |
494 | 492 |
#plot(r_ref) |
495 | 493 |
} |
496 | 494 |
|
497 |
list_args_weights <- (mixedsort(list.files(pattern="r_weigts_m_.*.tif"))) |
|
495 |
##Create raster image for prod weights matching resolution and extent to the mosaic |
|
496 |
|
|
497 |
lf_files <- list_r_weights_prod |
|
498 |
r_m <- raster("avg.tif") |
|
499 |
|
|
500 |
for (i in 1:length(lf_files)){ |
|
501 |
set1f <- function(x){rep(NA, x)} |
|
502 |
r_ref <- init(r_m, fun=set1f, filename=paste('r_weights_prod_m_',i,'.tif',sep=""), overwrite=TRUE) |
|
503 |
#NAvalue(r_ref) <- -9999 |
|
504 |
|
|
505 |
cmd_str <- paste("/usr/bin/gdalwarp",lf_files[[i]],paste('r_weights_prod_m_',i,'.tif',sep=""),sep=" ") |
|
506 |
#gdalwarp -t_srs '+proj=utm +zone=11 +datum=WGS84' raw_spot.tif utm11.tif |
|
507 |
|
|
508 |
system(cmd_str) |
|
509 |
#r_ref <-raster("r_ref.tif") |
|
510 |
#plot(r_ref) |
|
511 |
} |
|
512 |
|
|
513 |
## Create raster image for original predicted images with matching resolution and extent to the mosaic (reference image) |
|
514 |
lf_files <- lf_mosaic_pred_1500x4500 |
|
515 |
lf_out <- vector("list",length(lf_files)) |
|
516 |
r_m <- raster("avg.tif") #ref image |
|
517 |
|
|
518 |
#Make this a full function... |
|
519 |
for (i in 1:length(lf_files)){ |
|
520 |
set1f <- function(x){rep(NA, x)} |
|
521 |
|
|
522 |
inFilename <- lf_files[i] |
|
523 |
extension_str <- extension(inFilename) |
|
524 |
raster_name_tmp <- gsub(extension_str,"",basename(inFilename)) |
|
525 |
#outFilename <- file.path(out_dir,paste(raster_name_tmp,"_","m_",out_suffix,file_format,sep="")) #for use in function later... |
|
526 |
|
|
527 |
r_ref <- init(r_m, fun=set1f, filename=paste(raster_name_tmp,"_","m_",out_suffix,file_format,sep=""), overwrite=TRUE) |
|
528 |
#NAvalue(r_ref) <- -9999 |
|
529 |
|
|
530 |
cmd_str <- paste("/usr/bin/gdalwarp",inFilename,paste(raster_name_tmp,"_","m_",out_suffix,file_format,sep=""),sep=" ") |
|
531 |
#gdalwarp -t_srs '+proj=utm +zone=11 +datum=WGS84' raw_spot.tif utm11.tif |
|
532 |
|
|
533 |
system(cmd_str) |
|
534 |
#r_ref <-raster("r_ref.tif") |
|
535 |
#plot(r_ref) |
|
536 |
lf_out <- "" |
|
537 |
} |
|
538 |
|
|
539 |
list_args_weights_prod <- (mixedsort(list.files(pattern="r_weights_prod_m_.*.tif"))) |
|
540 |
list_args_weights_prod <- lapply(1:length(list_args_weights_prod), FUN=function(i,x){raster(x[[i]])},x=list_args_weights_prod) |
|
541 |
|
|
542 |
list_args_weights <- (mixedsort(list.files(pattern="r_weights_m_.*.tif"))) |
|
498 | 543 |
list_args_weights <- lapply(1:length(list_args_weights), FUN=function(i,x){raster(x[[i]])},x=list_args_weights) |
499 | 544 |
|
500 |
#list_args_weights_prod <- list_r_weights_prod |
|
545 |
#lf_mosaic_pred_1500x4500 <-list.files(path=file.path(in_dir), |
|
546 |
# pattern=paste(".*.tif$",sep=""),full.names=T) |
|
547 |
|
|
548 |
list_args_pred_m <- (mixedsort(list.files(pattern="^gam_CAI.*.m_mosaic_run10_1500x4500_global_analyses_03252015.tif"))) |
|
549 |
list_args_pred_m <- lapply(1:length(list_args_pred_m), FUN=function(i,x){raster(x[[i]])},x=list_args_pred_m) |
|
501 | 550 |
|
502 | 551 |
list_args_weights$fun <- "sum" |
503 | 552 |
#list_args_weights$fun <- "mean" |
504 |
|
|
505 | 553 |
list_args_weights$na.rm <- TRUE |
506 | 554 |
#list_args_weights$tolerance <- 1 |
507 | 555 |
|
556 |
list_args_weights_prod$fun <- "sum" |
|
557 |
list_args_weights_prod$na.rm <- TRUE |
|
558 |
|
|
559 |
list_args_pred_m$fun <- "mean" |
|
560 |
list_args_pred_m$na.rm <- TRUE |
|
561 |
|
|
508 | 562 |
#l#ist_args_weights_prod$fun <- "sum" |
509 | 563 |
#list_args_weights_prod$na.rm <- TRUE |
510 | 564 |
#list_args_weights_prod$na.rm <- TRUE |
511 | 565 |
|
512 | 566 |
r_weights_sum <- do.call(mosaic,list_args_weights) #sum |
513 |
#r_prod_sum <- do.call(mosaic,list_args_weights_prod) #sum |
|
514 |
|
|
515 |
r_weighted_mean <- r_weights_sum/r_prod_sum |
|
516 |
|
|
517 |
################################################# |
|
518 |
#Ok testing on fake data: |
|
567 |
r_prod_sum <- do.call(mosaic,list_args_weights_prod) #sum |
|
519 | 568 |
|
520 |
##Quick function to generate test dataset |
|
521 |
make_raster_from_lf <- function(i,list_lf,r_ref){ |
|
522 |
vect_val <- list_lf[[i]] |
|
523 |
r <- r_ref |
|
524 |
values(r) <-vect_val |
|
525 |
#writeRaster... |
|
526 |
return(r) |
|
527 |
} |
|
569 |
r_m_weighted_mean <- r_prod_sum/r_weights_sum #this is the mosaic using weighted mean... |
|
528 | 570 |
|
529 |
vect_pred1 <- c(9,4,1,3,5,9,9,9,2) |
|
530 |
vect_pred2 <- c(10,3,1,2,4,8,7,8,2) |
|
531 |
vect_pred3 <- c(10,NA,NA,3,5,9,8,9,2) |
|
532 |
vect_pred4 <- c(9,3,2,NA,5,8,9,9,2) |
|
533 |
lf_vect_pred <- list(vect_pred1,vect_pred2,vect_pred3,vect_pred4) |
|
571 |
#extension_str <- extension(lf[i]) |
|
572 |
#raster_name_tmp <- gsub(extension_str,"",basename(lf[i])) |
|
573 |
raster_name <- file.path(out_dir,paste("r_m_weighted_mean",out_suffix,".tif",sep="")) |
|
574 |
writeRaster(r_m_weighted_mean, NAflag=NA_flag_val,filename=raster_name,overwrite=TRUE) |
|
534 | 575 |
|
535 |
vect_w1 <- c(0.2,0.5,0.1,0.3,0.4,0.5,0.5,0.3,0.2) |
|
536 |
vect_w2 <- c(0.3,0.4,0.1,0.3,0.4,0.5,0.7,0.1,0.2) |
|
537 |
vect_w3 <- c(0.5,0.3,0.2,0.2,0.3,0.6,0.7,0.3,0.2) |
|
538 |
vect_w4 <- c(0.2,0.5,0.3,0.3,0.4,0.5,0.5,0.2,0.2) |
|
539 |
lf_vect_w <- list(vect_w1,vect_w2,vect_w3,vect_w4) |
|
540 |
df_vect_w <-do.call(cbind,lf_vect_w) |
|
541 |
df_vect_pred <-do.call(cbind,lf_vect_pred) |
|
576 |
r_m_mean <- do.call(mosaic,list_args_pred_m) #this is unweighted mean |
|
542 | 577 |
|
543 |
tr_ref <- raster(nrows=3,ncols=3) |
|
578 |
res_pix <- 1200 |
|
579 |
col_mfrow <- 1 |
|
580 |
row_mfrow <- 0.8 |
|
544 | 581 |
|
545 |
r_pred_l <- lapply(1:length(lf_vect_pred),FUN=make_raster_from_lf,list_lf=lf_vect_pred,r_ref=r_ref) |
|
546 |
r_w_l <- lapply(1:length(lf_vect_w),FUN=make_raster_from_lf,list_lf=lf_vect_w,r_ref=r_ref) |
|
547 |
|
|
548 |
#r_w1<- make_raster_from_lf(2,list_lf=lf_vect_w,r_ref) |
|
582 |
png(filename=paste("Figure2_mean_for_region_",region_names[1],"_",out_suffix,".png",sep=""), |
|
583 |
width=col_mfrow*res_pix,height=row_mfrow*res_pix) |
|
549 | 584 |
|
550 |
list_args_pred <- r_pred_l |
|
551 |
list_args_pred$fun <- "sum" |
|
585 |
plot(r_m_mean) |
|
552 | 586 |
|
553 |
list_args_w <- r_w_l |
|
554 |
list_args_w$fun <- prod |
|
587 |
dev.off() |
|
555 | 588 |
|
556 |
r_test_val <-do.call(overlay,list_args) #sum |
|
557 |
r_test_w <-do.call(overlay,list_args_w) #prod |
|
589 |
res_pix <- 1200 |
|
590 |
col_mfrow <- 1 |
|
591 |
row_mfrow <- 0.8 |
|
558 | 592 |
|
559 |
#need to do sumprod |
|
560 |
r1<- r_w_l[[1]]*r_pred_l[[1]] |
|
561 |
r2<- r_w_l[[2]]*r_pred_l[[2]] |
|
562 |
r3<- r_w_l[[3]]*r_pred_l[[3]] |
|
563 |
r4<- r_w_l[[4]]*r_pred_l[[4]] |
|
593 |
png(filename=paste("Figure2_weigthed_mean_for_region_",region_names[1],"_",out_suffix,".png",sep=""), |
|
594 |
width=col_mfrow*res_pix,height=row_mfrow*res_pix) |
|
564 | 595 |
|
565 |
r_pred <- stack(r_pred_l) |
|
566 |
r_w <- stack(r_w_l) |
|
596 |
plot(r_m_weighted_mean) |
|
567 | 597 |
|
568 |
list_args_pred <- r_pred_l |
|
569 |
list_args_pred$fun <- mean |
|
570 |
list_args_pred$na.rm <- TRUE |
|
571 |
#r_sum_pred <-do.call(overlay,list_args_pred) #prod |
|
598 |
dev.off() |
|
572 | 599 |
|
573 |
#r_sum_pred <-do.call(mean,list_args_pred) #prod |
|
574 |
r_sum_pred <-do.call(mosaic,list_args_pred) #prod |
|
575 | 600 |
|
576 |
list_args_pred$na.rm <- FALSE |
|
577 |
r_sum_pred <-do.call(overlay,list_args_pred) #prod |
|
601 |
##################### END OF SCRIPT ###################### |
|
578 | 602 |
|
579 |
r_sum_pred <-do.call(overlay,list_args_w) #prod |
|
580 | 603 |
|
581 |
list_args_w$fun <- sum
|
|
582 |
r_sum_w <-do.call(overlay,list_args_w) #prod
|
|
604 |
#################################################
|
|
605 |
#Ok testing on fake data:
|
|
583 | 606 |
|
584 |
r_m_w <- ((r1+r2+r3+r4)/(r_sum_w)) #mean weiated |
|
607 |
##Quick function to generate test dataset |
|
608 |
# make_raster_from_lf <- function(i,list_lf,r_ref){ |
|
609 |
# vect_val <- list_lf[[i]] |
|
610 |
# r <- r_ref |
|
611 |
# values(r) <-vect_val |
|
612 |
# #writeRaster... |
|
613 |
# return(r) |
|
614 |
# } |
|
615 |
# |
|
616 |
# vect_pred1 <- c(9,4,1,3,5,9,9,9,2) |
|
617 |
# vect_pred2 <- c(10,3,1,2,4,8,7,8,2) |
|
618 |
# vect_pred3 <- c(10,NA,NA,3,5,9,8,9,2) |
|
619 |
# vect_pred4 <- c(9,3,2,NA,5,8,9,9,2) |
|
620 |
# lf_vect_pred <- list(vect_pred1,vect_pred2,vect_pred3,vect_pred4) |
|
621 |
# |
|
622 |
# vect_w1 <- c(0.2,0.5,0.1,0.3,0.4,0.5,0.5,0.3,0.2) |
|
623 |
# vect_w2 <- c(0.3,0.4,0.1,0.3,0.4,0.5,0.7,0.1,0.2) |
|
624 |
# vect_w3 <- c(0.5,0.3,0.2,0.2,0.3,0.6,0.7,0.3,0.2) |
|
625 |
# vect_w4 <- c(0.2,0.5,0.3,0.3,0.4,0.5,0.5,0.2,0.2) |
|
626 |
# lf_vect_w <- list(vect_w1,vect_w2,vect_w3,vect_w4) |
|
627 |
# df_vect_w <-do.call(cbind,lf_vect_w) |
|
628 |
# df_vect_pred <-do.call(cbind,lf_vect_pred) |
|
629 |
# |
|
630 |
# tr_ref <- raster(nrows=3,ncols=3) |
|
631 |
# |
|
632 |
# r_pred_l <- lapply(1:length(lf_vect_pred),FUN=make_raster_from_lf,list_lf=lf_vect_pred,r_ref=r_ref) |
|
633 |
# r_w_l <- lapply(1:length(lf_vect_w),FUN=make_raster_from_lf,list_lf=lf_vect_w,r_ref=r_ref) |
|
634 |
# |
|
635 |
# #r_w1<- make_raster_from_lf(2,list_lf=lf_vect_w,r_ref) |
|
636 |
# |
|
637 |
# list_args_pred <- r_pred_l |
|
638 |
# list_args_pred$fun <- "sum" |
|
639 |
# |
|
640 |
# list_args_w <- r_w_l |
|
641 |
# list_args_w$fun <- prod |
|
642 |
# |
|
643 |
# r_test_val <-do.call(overlay,list_args) #sum |
|
644 |
# r_test_w <-do.call(overlay,list_args_w) #prod |
|
645 |
# |
|
646 |
# #need to do sumprod |
|
647 |
# r1<- r_w_l[[1]]*r_pred_l[[1]] |
|
648 |
# r2<- r_w_l[[2]]*r_pred_l[[2]] |
|
649 |
# r3<- r_w_l[[3]]*r_pred_l[[3]] |
|
650 |
# r4<- r_w_l[[4]]*r_pred_l[[4]] |
|
651 |
# |
|
652 |
# r_pred <- stack(r_pred_l) |
|
653 |
# r_w <- stack(r_w_l) |
|
654 |
# |
|
655 |
# list_args_pred <- r_pred_l |
|
656 |
# list_args_pred$fun <- mean |
|
657 |
# list_args_pred$na.rm <- TRUE |
|
658 |
# #r_sum_pred <-do.call(overlay,list_args_pred) #prod |
|
659 |
# |
|
660 |
# #r_sum_pred <-do.call(mean,list_args_pred) #prod |
|
661 |
# r_sum_pred <-do.call(mosaic,list_args_pred) #prod |
|
662 |
# |
|
663 |
# list_args_pred$na.rm <- FALSE |
|
664 |
# r_sum_pred <-do.call(overlay,list_args_pred) #prod |
|
665 |
# |
|
666 |
# r_sum_pred <-do.call(overlay,list_args_w) #prod |
|
667 |
# |
|
668 |
# list_args_w$fun <- sum |
|
669 |
# r_sum_w <-do.call(overlay,list_args_w) #prod |
|
670 |
# |
|
671 |
# r_m_w <- ((r1+r2+r3+r4)/(r_sum_w)) #mean weiated |
|
585 | 672 |
#n33e to check the result!! especially the nubmer of valid pix val |
586 | 673 |
|
587 | 674 |
#r_test_val <-do.call(overlay,list_args) #sum |
... | ... | |
621 | 708 |
# system(cmd_str) |
622 | 709 |
# |
623 | 710 |
#} |
624 |
|
|
625 |
##################### END OF SCRIPT ###################### |
Also available in: Unified diff
scaling up mosaicing experiment, testing weighted mean with linear scaling and mean mosaic