Project

General

Profile

« Previous | Next » 

Revision 156b5e38

Added by Benoit Parmentier over 9 years ago

scaling up mosaicing experiment, testing weighted mean with linear scaling and mean mosaic

View differences:

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