Revision 84774d51
Added by Benoit Parmentier over 11 years ago
| climate/research/oregon/interpolation/covariates_production_temperatures.R | ||
|---|---|---|
| 11 | 11 |
# -24 LST layers: "climatology" produced from MOD11A1, LST (mean and obs) using script in step 1 of workflow |
| 12 | 12 |
# 3) The output is a multiband file in tif format with projected covariates for the processing region/tile. |
| 13 | 13 |
#AUTHOR: Benoit Parmentier |
| 14 |
#DATE: 05/27/2013
|
|
| 14 |
#DATE: 06/19/2013
|
|
| 15 | 15 |
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#363-- |
| 16 | 16 |
|
| 17 | 17 |
##Comments and TODO: |
| ... | ... | |
| 166 | 166 |
return(unlist(lf_new_names_list)) |
| 167 | 167 |
} |
| 168 | 168 |
|
| 169 |
screening_val_r_stack_fun<-function(list_val_range,r_stack){
|
|
| 170 |
#Screening values for raster stack |
|
| 171 |
#input: list_val_range: list of character strings comma separated |
|
| 172 |
# e.g.: "mm_12,-15,50","mm_12,-15,50" |
|
| 173 |
# variable name, min value, max value |
|
| 174 |
|
|
| 175 |
|
|
| 176 |
tab_range_list<-do.call(rbind,as.list(list_val_range)) |
|
| 177 |
|
|
| 178 |
#tab_range <- strsplit(tab_range_list[[j]],",") |
|
| 179 |
|
|
| 180 |
tab_range <- strsplit(tab_range_list,",") |
|
| 181 |
tab_range <-as.data.frame(do.call(rbind, tab_range)) |
|
| 182 |
names(tab_range)<-c("varname","vmin","vmax")
|
|
| 183 |
tab_range$vmin <- as.numeric(tab_range$vmin) |
|
| 184 |
tab_range$vmax <- as.numeric(tab_range$vmax) |
|
| 185 |
val_rst<-vector("list",nrow(tab_range)) #list of one row data.frame
|
|
| 186 |
|
|
| 187 |
for (k in 1:nrow(tab_range)){
|
|
| 188 |
avl<-c(-Inf,tab_range$vmin[k],NA, tab_range$vmax[k],+Inf,NA) #This creates a input vector...val 1 are -9999, 2 neg, 3 positive |
|
| 189 |
rclmat<-matrix(avl,ncol=3,byrow=TRUE) |
|
| 190 |
#s_raster_r<-raster(r_stack,match(tab_range$varterm[k],names(r_stack))) #select relevant layer from stack |
|
| 191 |
s_raster_r<-raster(r_stack,match(tab_range$varname[k],names(r_stack))) |
|
| 192 |
s_raster_r<-reclassify(s_raster_r,rclmat) #now reclass values |
|
| 193 |
#r_stack<-dropLayer(r_stack,match(tab_range$varname[k],names(r_stack))) |
|
| 194 |
names(s_raster_r)<-tab_range$varname[k] #Loss of layer names when using reclass |
|
| 195 |
val_rst[[k]]<-s_raster_r |
|
| 196 |
} |
|
| 197 |
#could be taken out of function for parallelization |
|
| 198 |
s_rst_m<-stack(val_rst) #This a raster stack with valid range of values |
|
| 199 |
retained_names<-setdiff(names(r_stack),as.character(tab_range$varname)) |
|
| 200 |
r_stack <- dropLayer(r_stack,match(tab_range$varname,names(r_stack))) |
|
| 201 |
names(r_stack) <-retained_names |
|
| 202 |
r_stack <- addLayer(r_stack,s_rst_m) #add back layers that were screened out |
|
| 203 |
|
|
| 204 |
return(r_stack) |
|
| 205 |
} |
|
| 206 |
|
|
| 169 | 207 |
covariates_production_temperature<-function(list_param){
|
| 170 | 208 |
#This functions produce covariates used in the interpolation of temperature. |
| 171 | 209 |
#It requires 16 arguments: |
| ... | ... | |
| 187 | 225 |
#16) hdfdir: directory where the LST averages are stored... |
| 188 | 226 |
#17) out_suffix_modis : suffix used in producing LST climatology |
| 189 | 227 |
#18) covar_names : names of covariates |
| 190 |
# |
|
| 228 |
#19) list_val_range: names and valid range for covariates in brick
|
|
| 191 | 229 |
# |
| 192 | 230 |
|
| 193 | 231 |
###Loading R library and packages |
| ... | ... | |
| 226 | 264 |
hdfdir <- list_param$hdfdir |
| 227 | 265 |
out_suffix_modis <- list_param$out_suffix_modis |
| 228 | 266 |
covar_names<-list_param$covar_names |
| 267 |
list_val_range <-list_param$list_val_range |
|
| 229 | 268 |
|
| 230 | 269 |
##### SET UP STUDY AREA #### |
| 231 | 270 |
|
| ... | ... | |
| 437 | 476 |
names(s_raster)<-covar_names |
| 438 | 477 |
|
| 439 | 478 |
##Write function to screen data values... |
| 440 |
|
|
| 441 |
#Screen LST for extreme values? |
|
| 442 |
#min_val<-(-15+273.16) #if values less than -15C then screen out (note the Kelvin units that will need to be changed later in all datasets) |
|
| 443 |
#LST[LST < (min_val)]<-NA |
|
| 444 |
|
|
| 445 | 479 |
#add screening here... |
| 480 |
#browser() |
|
| 481 |
#test <-screening_val_r_stack_fun(list_val_range,s_raster) |
|
| 482 |
s_raster<-screening_val_r_stack_fun(list_val_range,s_raster) |
|
| 446 | 483 |
|
| 447 | 484 |
#Write out stack of number of change |
| 448 | 485 |
data_name<-paste("covariates_",out_region_name,"_",sep="")
|
| ... | ... | |
| 454 | 491 |
#using bil format more efficient?? |
| 455 | 492 |
|
| 456 | 493 |
#return reg_outline!!! |
| 457 |
covar_obj <-list(raster_name,infile_reg_outline) |
|
| 458 |
names(covar_obj) <-c("infile_covariates","infile_reg_outline")
|
|
| 494 |
covar_obj <-list(raster_name,infile_reg_outline,names(s_raster))
|
|
| 495 |
names(covar_obj) <-c("infile_covariates","infile_reg_outline","covar_names")
|
|
| 459 | 496 |
return(covar_obj) |
| 460 | 497 |
} |
| 461 | 498 |
|
Also available in: Unified diff
covariates production function, adding screening for extreme values