Project

General

Profile

Download (18.7 KB) Statistics
| Branch: | Revision:
1
##################    Data preparation for interpolation   #######################################
2
############################ Covariate production for a given tile/region ##########################################
3
#This script produces covariates raster for a a specfied study area.                             
4
# It requires the following inputs:                                                              
5
# 1)list of modis tiles or shape file with region outline            
6
# 2)input names for global covariates:
7
# -SRTM CGIAR 1 km
8
# -Canopy heihgt (Simard)
9
# -land cover concensus (Jetz lab)
10
# -MODIS LST: mean and obs
11
#3) The output is a multiband file in tif format with projected covariates for the processing region/tile.             
12
#AUTHOR: Benoit Parmentier                                                                       
13
#DATE: 03/19/2013                                                                                 
14
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#363--   
15

    
16
##Comments and TODO:
17
#This script is meant to be for general processing tile by tile or region by region.
18
#We must decide on a local projection. This can best set up from the tile/region extent: for now use
19
#- lcc with two standard paralells and one central meridian in the middle of the region.
20
#- produce a distance to ocean layer that is global.
21
#- do not keep output in memory??
22

    
23
##################################################################################################
24

    
25
###Loading R library and packages   
26
library(RPostgreSQL)
27
library(sp)                                             # Spatial pacakge with class definition by Bivand et al.
28
library(spdep)                                          # Spatial pacakge with methods and spatial stat. by Bivand et al.
29
library(rgdal)                                          # GDAL wrapper for R, spatial utilities
30
library(raster)
31
library(gtools)
32
library(rasterVis)
33
library(graphics)
34
library(grid)
35
library(lattice)
36

    
37
### Parameters and arguments
38

    
39
##Paths to inputs and output
40
var<-"TMAX"
41
in_path <- "/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/input_data/"
42
out_path<- "/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/output_data/"
43
lc_path<-"/home/layers/data/land-cover/lc-consensus-global"
44
#elev_path<-"/home/layers/data/terrain/dem-cgiar-srtm-1km-tif"
45
#infile3<-"countries_sinusoidal_world.shp"
46
#infile1<-"worldborder_sinusoidal.shp"
47
infile_modis_grid<-"modis_sinusoidal_grid_world.shp"
48
infile_elev<-"/home/layers/data/terrain/dem-cgiar-srtm-1km-tif/srtm_1km.tif"  #this is the global file: replace later with the input produced by the DEM team
49
infile_canheight<-"Simard_Pinto_3DGlobalVeg_JGR.tif"              #Canopy height
50
list_tiles_modis = c('h11v08','h11v07','h12v07','h12v08','h10v07','h10v08') #tile for Venezuel and surrounding area
51
infile_reg_outline=""  #input region outline defined by polygon
52
CRS_interp<-"+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs";
53
CRS_locs_WGS84<-CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +towgs84=0,0,0") #Station coords WGS84
54
out_region_name<-"_venezuela_region" #generated on the fly
55
out_suffix<-"_VE_03182013"
56
ref_rast_name<-""  #local raster name defining resolution, exent, local projection--. set on the fly??
57
                   #for the processing tile/region? This is a group fo six tiles for now.
58

    
59
#The names of covariates can be changed...these names should be output/input from covar script!!!
60
rnames<-c("x","y","lon","lat","N","E","N_w","E_w","elev","slope","aspect","CANHEIGHT","DISTOC")
61
lc_names<-c("LC1","LC2","LC3","LC4","LC5","LC6","LC7","LC8","LC9","LC10","LC11","LC12")
62
lst_names<-c("mm_01","mm_02","mm_03","mm_04","mm_05","mm_06","mm_07","mm_08","mm_09","mm_10","mm_11","mm_12",
63
             "nobs_01","nobs_02","nobs_03","nobs_04","nobs_05","nobs_06","nobs_07","nobs_08",
64
             "nobs_09","nobs_10","nobs_11","nobs_12")
65
covar_names<-c(rnames,lc_names,lst_names)
66

    
67
list_param_covar_production<-list(var,in_path,out_path,lc_path,infile_modis_grid,infile_elev,infile_canheight,
68
                                  list_tiles_modis,infile_reg_outline,CRS_interp,CRS_locs_WGS84,out_region_name,
69
                                  out_suffix,ref_rast_name,covar_names) 
70

    
71
names(list_param_covar_production)<-c("var","in_path","out_path","lc_path","infile_modis_grid","infile_elev","infile_canheight",
72
                                  "list_tiles_modis","infile_reg_outline","CRS_interp","CRS_locs_WGS84","out_region_name",
73
                                  "out_suffix","ref_rast_name","covar_names") 
74

    
75
#LST_night_rast<-raster("mean_LST_Night_1km_h11v08_dec_11_03192013.tif")
76
#### Functions used in the script  ###
77

    
78
create_modis_tiles_region<-function(modis_grid,tiles){
79
  #This functions returns a subset of tiles from the modis grdi.
80
  #Arguments: modies grid tile,list of tiles
81
  #Output: spatial grid data frame of the subset of tiles
82
  
83
  h_list<-lapply(tiles,substr,start=2,stop=3) #passing multiple arguments
84
  v_list<-lapply(tiles,substr,start=5,stop=6) #passing multiple arguments
85
  
86
  selected_tiles<-subset(subset(modis_grid,subset = h %in% as.numeric (h_list) ),
87
                         subset = v %in% as.numeric(v_list)) 
88
  return(selected_tiles)
89
}
90

    
91
#This function is very very slow not be used most likely
92
create_polygon_from_extent<-function(reg_ref_rast){
93
  #This functions returns polygon sp from input rast
94
  #Arguments: input ref rast
95
  #Output: spatial polygon
96
  set1f <- function(x){rep(1, x)}
97
  tmp_rast <- init(reg_ref_rast, fun=set1f, overwrite=TRUE)
98
  reg_outline_poly<-rasterToPolygons(tmp_rast)
99
  return(reg_outline_poly)
100
}
101

    
102
create_raster_region <-function(raster_name,reg_ref_rast){
103
  #This functions returns a subset of tiles from the modis grdi.
104
  #Arguments: raster name of the file,reference file with
105
  #Output: spatial grid data frame of the subset of tiles
106
  
107
  layer_rast<-raster(raster_name)
108
  new_proj<-proj4string(layer_rast)                  #Extract coordinates reference system in PROJ4 format
109
  region_temp_projected<-projectExtent(reg_ref_rast,CRS(new_proj))     #Project from current to region coord. system
110
  layer_crop_rast<-crop(layer_rast, region_temp_projected) #crop using the extent from teh region tile
111
  #layer_projected_rast<-projectRaster(from=layer_crop_rast,crs=proj4string(reg_outline),method="ngb")
112
  layer_projected_rast<-projectRaster(from=layer_crop_rast,to=reg_ref_rast,method="ngb")
113
  return(layer_projected_rast)
114
}
115

    
116
mosaic_raster_list<-function(mosaic_list,out_names,out_path){
117
  #This functions returns a subset of tiles from the modis grid.
118
  #Arguments: modies grid tile,list of tiles
119
  #Output: spatial grid data frame of the subset of tiles
120
  #Note that rasters are assumed to be in the same projection system!!
121
  
122
  rast_list<-vector("list",length(mosaic_list))
123
  for (i in 1:length(mosaic_list)){  
124
    # read the individual rasters into a list of RasterLayer objects
125
    # this may be changed so that it is not read in the memory!!!
126
    input.rasters <- lapply(as.character(mosaic_list[[i]]), raster)
127
    mosaiced_rast<-input.rasters[[1]]
128
    
129
    for (k in 2:length(input.rasters)){
130
      mosaiced_rast<-mosaic(mosaiced_rast,input.rasters[[k]], fun=mean)
131
      #mosaiced_rast<-mosaic(mosaiced_rast,raster(input.rasters[[k]]), fun=mean)
132
    }
133
    data_name<-paste("mosaiced_",sep="") #can add more later...
134
    raster_name<-paste(data_name,out_names[i],".tif", sep="")
135
    writeRaster(mosaiced_rast, filename=file.path(out_path,raster_name),overwrite=TRUE)  
136
    #Writing the data in a raster file format...  
137
    rast_list[[i]]<-file.path(out_path,raster_name)
138
  }
139
  return(rast_list)
140
}
141

    
142
covariates_production_temperature<-function(list_param){
143
  #This functions produce covariates used in the interpolation of temperature.
144
  #It requires 15 arguments:
145
  #
146
  #
147
  #
148
  ###########################################################
149
  ############ Main body: BEGIN--START OF THE SCRIPT ###################
150
  
151
  ##### STEP 1: Reading region or tile information to set the study or processing region
152
  
153
  var<-list_param$var
154
  in_path <-list_param$in_path
155
  out_path<- list_param$out_path
156
  lc_path<-list_param$lc_path 
157
  #elev_path<-"/home/layers/data/terrain/dem-cgiar-srtm-1km-tif"
158
  #infile3<-"countries_sinusoidal_world.shp"
159
  #infile1<-"worldborder_sinusoidal.shp"
160
  infile_modis_grid<-list_param$infile_modis_grid
161
  infile_elev<-list_param$infile_elev #this is the global file: replace later with the input produced by the DEM team
162
  infile_canheight<-list_param$infile_canheight #Canopy height
163
  list_tiles_modis<-list_param$list_tiles_modis #tile for Venezuel and surrounding area
164
  infile_reg_outline<-list_param$infile_reg_outline   #input region outline defined by polygon
165
  CRS_interp<-list_param$CRS_interp #local projection system
166
  CRS_locs_WGS84<-list_param$CRS_locs_WGS84 #
167
  out_region_name<-list_param$out_region_name  #generated on the fly
168
  out_suffix<-list_param$out_suffix 
169
  ref_rast_name<-list_param$ref_rast_name #local raster name defining resolution, exent, local projection--. set on the fly??
170
  #for the processing tile/region? This is a group fo six tiles for now.
171
  
172
  covar_names<-list_param$covar_names 
173
  
174
  setwd(in_path)
175
  
176
  filename<-sub(".shp","",infile_modis_grid)       #Removing the extension from file.
177
  modis_grid<-readOGR(".", filename)     #Reading shape file using rgdal library
178
  #filename<-sub(".shp","",infile1)       #Removing the extension from file.
179
  #world_countries<-readOGR(".", filename)     #Reading shape file using rgdal library
180
  
181
  if (infile_reg_outline!=""){
182
    filename<-sub(".shp","",infile_reg_outline)   #Removing the extension from file.
183
    reg_outline<-readOGR(".", filename)
184
  }
185
  
186
  if (infile_reg_outline==""){
187
    reg_outline<-create_modis_tiles_region(modis_grid,list_tiles_modis) #problem...this does not 
188
    #align with extent of modis LST!!!
189
    writeOGR(reg_outline,dsn= ".",layer= paste("outline",out_region_name,"_",out_suffix,sep=""), 
190
             driver="ESRI Shapefile",overwrite_layer="TRUE")
191
  }
192
  
193
  #Should add option for a reference file here...
194
  #tmp<-extent(ref_rast)
195
  
196
  #modis_tiles<-create_modis_tiles_region(modis_grid,list_tiles_modis)
197
  ##Create covariates for the stuy area: pull everything from the same folder?
198
  
199
  #### STEP 2: process and/or produce covariates for the tile/region
200
  
201
  ################################
202
  #1) LST climatology: project, mosaic
203
  i<-1
204
  tile<-list_tiles_modis[i]
205
  if (var=="TMIN"){
206
    lst_pat<-"LST_Night_1km"
207
  }
208
  if (var=="TMAX"){
209
    lst_pat<-"" #for the time being change at later stage...
210
    #day_pat<-"LST_Day_1km"
211
  }
212
  
213
  #Get list of files containing the LST averages
214
  pat_str2 <- glob2rx(paste("nobs","*",lst_pat,"*.tif",sep=""))
215
  tmp_str2<- mixedsort(list.files(pattern=pat_str2))
216
  pat_str1 <- glob2rx(paste("mean","*",lst_pat,"*.tif",sep=""))
217
  tmp_str1<- mixedsort(list.files(pattern=pat_str1))
218
  #add lines using grep to select tiles...
219
 
220
  #Format list for mosaicing: mosaic for every month the relevant number of files
221
  #out_rastnames<-paste("_lst_","nobs",out_suffix,sep="")
222
  out_rastnames<-paste("_",lst_pat,"_","nobs",out_suffix,sep="")
223
  list_date_names<-c("jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec")
224
  mosaic_list<-split(tmp_str2,list_date_names)
225
  new_list<-vector("list",length(mosaic_list))
226
  for (i in 1:length(list_date_names)){
227
    j<-grep(list_date_names[i],mosaic_list,value=FALSE)
228
    names(mosaic_list)[j]<-list_date_names[i]
229
    new_list[i]<-mosaic_list[j]
230
  }
231
  mosaic_list<-new_list
232
  out_rastnames<-paste(list_date_names,out_rastnames,sep="")
233
  #reproject and crop if necessary
234
  #nobs_m_list<-list.files(pattern='mosaiced_.*._lst_nobs_VE_03182013.tif')
235
  nobs_m_list<-mosaic_raster_list(mosaic_list,out_rastnames,out_path)
236
  
237
  ##Now mosaic for mean: should reorder files!!
238
  pat_str1 <- glob2rx(paste("mean","*.tif",sep=""))
239
  tmp_str1<- mixedsort(list.files(pattern=pat_str1))
240
  out_rastnames<-paste("_",lst_pat,"_","mean",out_suffix,sep="")
241
  list_date_names<-c("jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec")
242
  mosaic_list<-split(tmp_str1,list_date_names)
243
  new_list<-vector("list",length(mosaic_list))
244
  for (i in 1:length(list_date_names)){
245
    j<-grep(list_date_names[i],mosaic_list,value=FALSE)
246
    names(mosaic_list)[j]<-list_date_names[i]
247
    new_list[i]<-mosaic_list[j]
248
  }
249
  mosaic_list<-new_list
250
  out_rastnames<-paste(list_date_names,out_rastnames,sep="")
251
  #mean_m_list<-list.files(pattern='mosaiced_.*._lst_mean_VE_03182013.tif')
252
  mean_m_list<-mosaic_raster_list(mosaic_list,out_rastnames,out_path)
253

    
254
  #Use this as ref file for now?? Ok for the time being: this will need to change to be a processing tile.
255
  ref_rast<-raster(mean_m_list[[1]])
256
  #ref_rast <-raster("mosaiced_dec_lst_mean_VE_03182013.tif")
257
  #Modis shapefile tile is slighly shifted:
258
  # +proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs for ref_rast
259
  #"+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs" ??
260
  #reassign proj from modis tile to raster? there is a 10m diff in semi-axes...(a and b)
261
  
262
  ##Write function to screen data values...
263
  
264
  #Screen LST for extreme values?
265
  #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)
266
  #LST[LST < (min_val)]<-NA
267
  
268
  #########################################
269
  ##2) Crop and reproject Canopy height data
270
  
271
  #Make it a function?
272
  #canopy_rast<-raster("Simard_Pinto_3DGlobalVeg_JGR.tif")
273
  canopy_name<-file.path(in_path,infile_canheight)
274
  
275
  CANHEIGHT<-create_raster_region(canopy_name,ref_rast)
276
  
277
  ##########################################
278
  #3) Creating elev, aspect, slope from STRM
279
  
280
  SRTM_reg<-create_raster_region(infile_elev,ref_rast)
281
  
282
  #Call a function to reproject the data in a local projection defined on the fly using the processing tile
283
  #extent...For the time being just use sinusoidal projection.
284
  ###calculate slope and aspect
285
  
286
  terrain_rast<-terrain(SRTM_reg, opt=c("slope","aspect"),unit="degrees", neighbors=8) #, filename=\u2019\u2019, ...)
287
  pos<-match("aspect",names(terrain_rast)) #Find column with name "value"
288
  r1<-raster(terrain_rast,layer=pos)             #Select layer from stack
289
  pos<-match("slope",names(terrain_rast)) #Find column with name "value"
290
  r2<-raster(terrain_rast,layer=pos)             #Select layer from stack
291
  N<-cos(r1)
292
  E<-sin(r1)
293
  Nw<-sin(r2)*cos(r1)   #Adding a variable to the dataframe
294
  Ew<-sin(r2)*sin(r1)   #Adding variable to the dataframe.
295
  
296
  #topo_rast<-stack(STRM_reg,N,E,Nw,Ew)
297
  
298
  ######################################
299
  #4) LCC land cover
300
  
301
  oldpath<-getwd()
302
  setwd(lc_path)
303
  #lc_name<-"con_1km_class_1.tif"
304
  lc_list<-list.files(pattern="con_1km_class_.*.tif")
305
  #lc<-raster(file.path(lc_path,lc_names))
306
  
307
  lc_reg_list<-vector("list",length(lc_list))
308
  for (i in 1:length(lc_list)){
309
    
310
    lc_name<-lc_list[[i]]
311
    lc_reg<-create_raster_region(lc_name,ref_rast)
312
    data_name<-paste("reg_",sub(".tif","",lc_name),"_",sep="") #can add more later...
313
    raster_name<-paste(data_name,out_suffix,".tif", sep="")
314
    writeRaster(lc_reg, filename=file.path(out_path,raster_name),overwrite=TRUE)  
315
    lc_reg_list[[i]]<-file.path(out_path,raster_name)
316
  }
317
  setwd(out_path)
318
  lc_reg_list<-mixedsort(list.files(pattern=paste("^reg_con_1km_class_.*.",out_suffix,".tif",sep="")))
319
  lc_reg_s<-stack(lc_reg_list)
320
  
321
  #Now combine forest classes...in LC1 forest, LC2, LC3, LC4 and LC6-urban...??
322
  
323
  #create a local mask for the tile/processing region
324
  
325
  #LC12<-raster(paste("reg_con_1km_class_12_",out_suffix,".tif",sep="")) #this is open water
326
  LC12<-raster(lc_reg_s,layer=nlayers(lc_reg_s)) #this is open water
327
  
328
  LC_mask<-LC12
329
  LC_mask[LC_mask==100]<-NA
330
  LC_mask <- LC_mask > 100
331
  #lc_reg_s<-mask(x=lc_reg_s,mask=LC_mask,filename=paste("reg_con_1km_all_classes_",out_suffix,".tif",sep=""),
332
  #               bandorder="BSQ",overwrite=TRUE)
333
  
334
  ###############################
335
  #5) DISTOC, distance to coast: Would be useful to have a distance to coast layer ready...
336
  
337
  #This does not work...clump needs igraph. I'll look into this later...for now I used IDRISI to clump pixels.
338
  #rc<-clump(LC12)
339
  #tab_freq<-freq(rc)
340
  #Modify at a later stage:
341
  #raster<-"DISTOC_VE_01292013.rst"  
342
  #ocean_rast<-raster(file.path(in_path,"lc12_tmp_grouped_rec.rst"))
343
  #ocean_rast[ocean_rast==0]<-NA
344
  #Distance calculated in a global layer??
345
  #distoc_reg<-distance(ocean_rast,doEdge=TRUE) #this is very slow: more than 35 min use GRASS instead??
346
  
347
  #load DISTOC produced from IDRISI: automate the process later
348
  distoc_reg<-raster(file.path(in_path,"DISTOC_VE_01292013.rst"))
349
  
350
  ################################
351
  #6) X-Y coordinates and LAT-LONG: do not keep in memory?
352
  #ref_rast <-raster("mosaiced_dec_lst_mean_VE_03182013.tif")
353
  r1 <-ref_rast
354
  xy <-coordinates(r1)  #get x and y projected coordinates...
355
  CRS_interp<-proj4string(r1)
356
  xy_latlon<-project(xy, CRS_interp, inv=TRUE) # find lat long for projected coordinats (or pixels...)
357
  x <-init(r1,v="x")
358
  y <-init(r1,v="y")
359
  lon <-x
360
  lat <-lon
361
  lon <-setValues(lon,xy_latlon[,1]) #longitude for every pixel in the processing tile/region
362
  lat <-setValues(lat,xy_latlon[,2]) #latitude for every pixel in the processing tile/region
363
  rm(r1)
364
  #coord_s<-stack(x,y,lat,lon)
365
  
366
  ################################
367
  ##Step 3: combine covariates in one stack for the next work flow stage
368
  #Create a stack in tif format...
369
  
370
  #? output name??
371
  r<-stack(x,y,lon,lat,N,E,Nw,Ew,SRTM_reg,terrain_rast,CANHEIGHT,distoc_reg)
372
  #rnames<-c("x","y","lon","lat","N","E","N_w","E_w","elev","slope","aspect","CANHEIGHT","DISTOC")
373
  #names(r)<-rnames
374
  s_raster<-r
375
  #Add landcover layers
376
  #lc_names<-c("LC1","LC2","LC3","LC4","LC5","LC6","LC7","LC8","LC9","LC10","LC11","LC12")
377
  #names(lc_reg_s)<-lc_names #assign land cover names
378
  s_raster<-addLayer(s_raster, lc_reg_s)
379
  
380
  lst_s<-stack(c(as.character(mean_m_list),as.character(nobs_m_list)))
381
  #lst_names<-c("mm_01","mm_02","mm_03","mm_04","mm_05","mm_06","mm_07","mm_08","mm_09","mm_10","mm_11","mm_12",
382
  #             "nobs_01","nobs_02","nobs_03","nobs_04","nobs_05","nobs_06","nobs_07","nobs_08",
383
  #             "nobs_09","nobs_10","nobs_11","nobs_12")
384
  #names(lst_s)<-lst_names
385
  s_raster<-addLayer(s_raster, lst_s)
386
  
387
  #covar_names<-c(rnames,lc_names,lst_names)
388
  names(s_raster)<-covar_names
389
  #Write out stack of number of change 
390
  data_name<-paste("covariates_",out_region_name,"_",sep="")
391
  raster_name<-paste(data_name,var,"_",out_suffix,".tif", sep="")
392
  #writeRaster(s_raster, filename=raster_name,NAflag=-999,bylayer=FALSE,bandorder="BSQ",overwrite=TRUE)  #Writing the data in a raster file format...
393
  s_raster_m<-mask(s_raster,LC_mask,filename=raster_name,
394
                 overwrite=TRUE,NAflag=-999,bylayer=FALSE,bandorder="BSQ")
395
  #using bil format more efficient??
396
  return(raster_name)
397
}
398

    
399

    
400
#######################################################
401
################### END OF SCRIPT/FUNCTION #####################
(20-20/40)