Revision 63540ef2
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: 06/20/2015
|
|
| 9 |
#Version: 4
|
|
| 8 |
#MODIFIED ON: 06/21/2015
|
|
| 9 |
#Version: 5
|
|
| 10 | 10 |
#PROJECT: Environmental Layers project |
| 11 | 11 |
#COMMENTS: analyses run for reg5 for test of mosaicing using 1500x4500km and other tiles |
| 12 | 12 |
#TODO: |
| ... | ... | |
| 49 | 49 |
#function_analyses_paper1 <-"contribution_of_covariates_paper_interpolation_functions_07182014.R" #first interp paper |
| 50 | 50 |
#function_analyses_paper2 <-"multi_timescales_paper_interpolation_functions_08132014.R" |
| 51 | 51 |
|
| 52 |
function_mosaicing <-"multi_timescales_paper_interpolation_functions_08132014.R"
|
|
| 52 |
function_mosaicing <-"global_run_scalingup_mosaicing_function_06212015.R"
|
|
| 53 | 53 |
|
| 54 | 54 |
in_dir_script <-"/home/parmentier/Data/IPLANT_project/env_layers_scripts" |
| 55 | 55 |
source(file.path(in_dir_script,function_mosaicing)) |
| ... | ... | |
| 67 | 67 |
y_var_name <- "dailyTmax" #PARAM1 |
| 68 | 68 |
interpolation_method <- c("gam_CAI") #PARAM2
|
| 69 | 69 |
region_name <- "reg2" #PARAM 13 #reg4 South America, Africa reg5,Europe reg2, North America reg1, Asia reg3 |
| 70 |
|
|
| 71 |
out_suffix <- paste(region_name,"_","mosaic_run10_1500x4500_global_analyses_06152015",sep="")
|
|
| 70 |
mosaicing_method <- c("unweighted","use_edge_weights")
|
|
| 71 |
out_suffix <- paste(region_name,"_","mosaic_run10_1500x4500_global_analyses_06212015",sep="")
|
|
| 72 | 72 |
#PARAM3 |
| 73 | 73 |
out_dir <- in_dir #PARAM4 |
| 74 | 74 |
create_out_dir_param <- TRUE #PARAM 5 |
| 75 | 75 |
|
| 76 |
mosaic_plot <- FALSE #PARAM6 |
|
| 77 |
|
|
| 78 | 76 |
#if daily mosaics NULL then mosaicas all days of the year |
| 79 | 77 |
day_to_mosaic <- c("20100831",
|
| 80 | 78 |
"20100901") #PARAM7 |
| 81 | 79 |
|
| 82 |
#CRS_locs_WGS84 <- CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +towgs84=0,0,0") #Station coords WGS84
|
|
| 83 |
CRS_WGS84 <- CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +towgs84=0,0,0") #Station coords WGS84 #CONSTANT1
|
|
| 84 |
CRS_locs_WGS84<-CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +towgs84=0,0,0") #Station coords WGS84
|
|
| 85 |
|
|
| 86 |
proj_str<- CRS_WGS84 #PARAM 8 #check this parameter |
|
| 87 | 80 |
file_format <- ".tif" #PARAM 9 |
| 88 | 81 |
NA_value <- -9999 #PARAM10 |
| 89 | 82 |
NA_flag_val <- NA_value |
| 90 | 83 |
|
| 91 | 84 |
num_cores <- 11 |
| 92 |
tile_size <- "1500x4500" #PARAM 11 |
|
| 93 |
mulitple_region <- TRUE #PARAM 12 |
|
| 94 |
|
|
| 95 |
plot_region <- FALSE |
|
| 96 | 85 |
|
| 97 | 86 |
########################## START SCRIPT ############################## |
| 98 | 87 |
|
| 99 | 88 |
|
| 100 | 89 |
####### PART 1: Read in data and process data ######## |
| 101 | 90 |
|
| 102 |
#make this a loop?, fistt use sept 1, 2010 data |
|
| 103 |
#out_suffix <- paste(day_to_mosaic[2],out_suffix,sep="_") |
|
| 104 |
|
|
| 105 | 91 |
in_dir <- file.path(in_dir,region_name) |
| 106 | 92 |
out_dir <- in_dir |
| 107 | 93 |
if(create_out_dir_param==TRUE){
|
| ... | ... | |
| 125 | 111 |
plot(r1) |
| 126 | 112 |
plot(r2) |
| 127 | 113 |
|
| 128 |
lf <- sub(".tif","",lf_mosaic2)
|
|
| 129 |
tx<-strsplit(as.character(lf),"_") |
|
| 130 |
|
|
| 131 |
lat<- as.character(lapply(1:length(tx),function(i,x){x[[i]][13]},x=tx))
|
|
| 132 |
long<- as.character(lapply(1:length(tx),function(i,x){x[[i]][14]},x=tx))
|
|
| 133 |
lat <- as.character(lapply(1:length(lat),function(i,x){substr(x[[i]],2,nchar(x[i]))},x=lat)) #first number not in the coordinates
|
|
| 134 |
|
|
| 135 |
#Produce data.frame with centroids of each tiles... |
|
| 136 |
|
|
| 137 |
df_centroids <- data.frame(long=as.numeric(long),lat=as.numeric(lat)) |
|
| 138 |
df_centroids$ID <- as.numeric(1:nrow(df_centroids)) |
|
| 139 |
coordinates(df_centroids) <- cbind(df_centroids$long,df_centroids$lat) |
|
| 140 |
proj4string(df_centroids) <- projection(r1) |
|
| 141 |
df_points <- df_centroids |
|
| 142 | 114 |
#methods availbable:use_sine_weights,use_edge,use_linear_weights |
| 143 |
out_suffix_str <- paste(day_to_mosaic[2],out_suffix,sep="_") |
|
| 144 |
|
|
| 145 |
#debug(mosaicFiles) |
|
| 146 |
mosaic_edge_20100901_obj <- mosaicFiles(lf_mosaic2,mosaic_method="use_edge_weights", |
|
| 147 |
num_cores=num_cores, |
|
| 148 |
python_bin=NULL, |
|
| 149 |
df_points=NULL,NA_flag=NA_flag_val, |
|
| 150 |
file_format=file_format,out_suffix=out_suffix_str, |
|
| 151 |
out_dir=out_dir) |
|
| 152 |
#debug(mosaicFiles) |
|
| 153 |
mosaic_method <- "edge" |
|
| 154 |
save(mosaic_unweighted_20100901_obj,file=file.path(out_dir, |
|
| 155 |
paste(mosaic_method,"_","mosaic_obj_", |
|
| 156 |
"20100901_",out_suffix,".RData",sep=""))) |
|
| 157 |
|
|
| 158 |
mosaic_unweighted_20100901_obj <- mosaicFiles(lf_mosaic2,mosaic_method="unweighted", |
|
| 115 |
#only use edge method for now |
|
| 116 |
#loop to dates... |
|
| 117 |
list_mosaic_obj <- vector("list",length=length(day_to_mosaic))
|
|
| 118 |
for(i in 1:length(day_to_mosaic)){
|
|
| 119 |
|
|
| 120 |
mosaic_method <- "use_edge_weights" |
|
| 121 |
out_suffix_str <- paste(day_to_mosaic[i],out_suffix,sep="_") |
|
| 122 |
#undebug(mosaicFiles) |
|
| 123 |
#can also loop through methods!!! |
|
| 124 |
mosaic_edge_obj <- mosaicFiles(lf_mosaic1,mosaic_method="use_edge_weights", |
|
| 159 | 125 |
num_cores=num_cores, |
| 160 | 126 |
python_bin=NULL, |
| 161 | 127 |
df_points=NULL,NA_flag=NA_flag_val, |
| 162 | 128 |
file_format=file_format,out_suffix=out_suffix_str, |
| 163 | 129 |
out_dir=out_dir) |
| 164 |
mosaic_method <- "unweighted" |
|
| 165 |
save(mosaic_unweighted_20100901_obj,file=file.path(out_dir,paste(mosaic_method,"_","mosaic_obj_", |
|
| 166 |
"20100901_",out_suffix,".RData",sep=""))) |
|
| 167 | 130 |
|
| 168 |
mosaic_method <- "edge" |
|
| 169 |
mosaic_edge_20100831_obj <- mosaicFiles(lf_mosaic1,mosaic_method="use_edge_weights", |
|
| 131 |
mosaic_unweighted_obj <- mosaicFiles(lf_mosaic1,mosaic_method="unweighted", |
|
| 170 | 132 |
num_cores=num_cores, |
| 171 | 133 |
python_bin=NULL, |
| 172 | 134 |
df_points=NULL,NA_flag=NA_flag_val, |
| 173 | 135 |
file_format=file_format,out_suffix=out_suffix_str, |
| 174 | 136 |
out_dir=out_dir) |
| 175 |
mosaic_method <- "edge" |
|
| 176 |
save(mosaic_edge_20100831_obj,file=file.path(out_dir, |
|
| 177 |
paste(mosaic_method,"_","mosaic_obj_", |
|
| 178 |
"20100831_",out_suffix,".RData",sep=""))) |
|
| 179 | 137 |
|
| 180 |
mosaic_unweighted_20100831_obj <- mosaicFiles(lf_mosaic1,mosaic_method="unweighted", |
|
| 181 |
num_cores=num_cores, |
|
| 182 |
python_bin=NULL, |
|
| 183 |
df_points=NULL,NA_flag=NA_flag_val, |
|
| 184 |
file_format=file_format,out_suffix=out_suffix_str, |
|
| 185 |
out_dir=out_dir) |
|
| 186 |
mosaic_method <- "unweighted" |
|
| 187 |
save(mosaic_unweighted_20100831_obj,file=file.path(out_dir,paste(mosaic_method,"_","mosaic_obj_", |
|
| 188 |
"20100831_",out_suffix,".RData",sep=""))) |
|
| 138 |
list_mosaic_obj[[i]] <- list(unweighted=mosaic_unweighted_obj,edge=mosaic_edge_obj) |
|
| 139 |
} |
|
| 189 | 140 |
|
| 190 | 141 |
##################### |
| 191 | 142 |
###### PART 2: Analysis and figures for the outputs of mosaic function ##### |
| 192 | 143 |
|
| 193 | 144 |
#### compute and aspect and slope with figures |
| 145 |
list_lf_mosaic_obj <- vector("list",length(day_to_mosaic))
|
|
| 146 |
lf_mean_mosaic <- vector("list",length(mosaicing_method))#2methods only
|
|
| 147 |
l_method_mosaic <- vector("list",length(mosaicing_method))
|
|
| 148 |
list_out_suffix <- vector("list",length(mosaicing_method))
|
|
| 149 |
|
|
| 150 |
for(i in 1:length(day_to_mosaic)){
|
|
| 151 |
list_lf_mosaic_obj[[i]] <- list.files(path=out_dir,pattern=paste("*",day_to_mosaic[i],
|
|
| 152 |
"_.*.RData",sep="")) |
|
| 153 |
lf_mean_mosaic[[i]] <- unlist(lapply(list_lf_mosaic_obj[[i]],function(x){load_obj(x)[["mean_mosaic"]]}))
|
|
| 154 |
l_method_mosaic[[i]] <- paste(unlist(lapply(list_lf_mosaic_obj[[i]],function(x){load_obj(x)[["method"]]})),day_to_mosaic[i],sep="_")
|
|
| 155 |
list_out_suffix[[i]] <- unlist(paste(l_method_mosaic[[i]],day_to_mosaic[[i]],out_suffix,sep="_")) |
|
| 156 |
} |
|
| 194 | 157 |
|
| 195 |
lf_mosaic_obj1 <- list.files(path=out_dir,pattern="*20100831_.*.RData") |
|
| 196 |
lf_mosaic_obj2 <- list.files(path=out_dir,pattern="*20100901_20100901.*.RData") |
|
| 197 |
lf_mosaic_obj <- unlist(list(lf_mosaic_obj1,lf_mosaic_obj2)) |
|
| 198 |
lf_mean_mosaic1 <- unlist(lapply(lf_mosaic_obj2,function(x){load_obj(x)[["mean_mosaic"]]}))
|
|
| 199 |
l_method_mosaic <- unlist(lapply(lf_mosaic_obj,function(x){load_obj(x)[["method"]]}))
|
|
| 200 |
|
|
| 201 |
out_suffix_tmp <- paste(c("edge","unweighted"),"20100831",sep="_")
|
|
| 202 |
#list_mosaic_unweighted <- list(mosaic_unweighted_20100831_obj,mosaic_edge_20100831_obj) |
|
| 203 |
#list_mosaic_edge <- list(mosaic_unweighted_20100901_obj,mosaic_edge_20100901_obj) |
|
| 204 |
|
|
| 205 |
#list_mosaiced_files <- c(list_mosaiced_files,r_m_mean_unweighted) |
|
| 206 |
#names(list_mosaiced_files2) <- c(names(list_mosaiced_files),"unweighted") |
|
| 207 | 158 |
|
| 208 |
#debug(plot_mosaic)
|
|
| 209 |
#lf_mean_mosaic1[1]
|
|
| 210 |
#plot_mosaic(lf_mean_mosaic1[1],method="edge",out_suffix="20100831")
|
|
| 211 |
list_param_plot_mosaic <- list(lf_mosaic=lf_mean_mosaic1,method=c("edge","unweighted"),out_suffix=c("20100831","20100831"))
|
|
| 212 |
#l_png_files <- lapply(1:length(lf_mean_mosaic1),FUN=plot_mosaic,list_param= list_param_plot_mosaic)
|
|
| 213 |
num_cores <- 2
|
|
| 214 |
l_png_files <- mclapply(1:length(lf_mean_mosaic1),FUN=plot_mosaic,list_param= list_param_plot_mosaic,
|
|
| 159 |
list_param_plot_mosaic <- list(lf_mosaic=unlist(lf_mean_mosaic),
|
|
| 160 |
method=unlist(l_method_mosaic),
|
|
| 161 |
out_suffix=unlist(list_out_suffix))
|
|
| 162 |
#undebug(plot_mosaic)
|
|
| 163 |
#plot_mosaic(1,list_param=list_param_plot_mosaic)
|
|
| 164 |
num_cores <- 4
|
|
| 165 |
l_png_files <- mclapply(1:length(lf_mean_mosaic),FUN=plot_mosaic,list_param= list_param_plot_mosaic, |
|
| 215 | 166 |
mc.preschedule=FALSE,mc.cores = num_cores) |
| 216 | 167 |
|
| 217 | 168 |
#################### |
| 218 | 169 |
#### Now difference figures... |
| 219 | 170 |
|
| 220 |
lf_obj2 <- list.files(path=out_dir,pattern="*edge_.*.RData") |
|
| 221 | 171 |
lf_obj1 <- list.files(path=out_dir,pattern="*unweighted.*.RData") |
| 172 |
lf_obj2 <- list.files(path=out_dir,pattern="*edge_.*.RData") |
|
| 222 | 173 |
|
| 223 |
lf1 <- unlist(lapply(lf_mosaic_obj2,function(x){load_obj(x)[["mean_mosaic"]]}))
|
|
| 224 |
lf2 <- unlist(lapply(lf_mosaic_obj1,function(x){load_obj(x)[["mean_mosaic"]]}))
|
|
| 174 |
lf1 <- unlist(lapply(lf_obj1,function(x){load_obj(x)[["mean_mosaic"]]}))
|
|
| 175 |
lf2 <- unlist(lapply(lf_obj2,function(x){load_obj(x)[["mean_mosaic"]]}))
|
|
| 225 | 176 |
|
| 226 |
list_param_plot_diff <- list(lf1=lf1,lf2=lf2,out_suffix=c("20100831","20100901"))
|
|
| 227 |
#l_png_files <- lapply(1:length(lf_mean_mosaic1),FUN=plot_mosaic,list_param= list_param_plot_mosaic) |
|
| 228 |
num_cores <- 2
|
|
| 177 |
out_suffix_str <- paste(paste(mosaicing_method,collapse="_"),day_to_mosaic,out_suffix,sep="_")
|
|
| 178 |
|
|
| 179 |
list_param_plot_diff <- list(lf1=lf1,lf2=lf2,out_suffix=out_suffix_str)
|
|
| 229 | 180 |
|
| 230 | 181 |
#debug(plot_diff_raster) |
| 231 | 182 |
#plot_diff_raster(1,list_param=list_param_plot_diff) |
Also available in: Unified diff
testing reg2 mosaicing automation with new functions