Revision e3448ab5
Added by Benoit Parmentier over 11 years ago
climate/research/oregon/interpolation/AAG2013_conference_Oregon_interpolation.R | ||
---|---|---|
1 |
#################################### INTERPOLATION TEMPERATURES ####################################### |
|
2 |
############################ SCRIPT 1- MEOT ####################################### |
|
3 |
#This script reads information concerning the Oregon case study to adapt data for the revised |
|
4 |
# interpolation code. |
|
5 |
#Figures and data for the AAG conference are also produced. |
|
6 |
#AUTHOR: Benoit Parmentier # |
|
7 |
#DATE: 04/03/2013 |
|
8 |
#Version: 1 |
|
9 |
#PROJECT: Environmental Layers project # |
|
10 |
################################################################################################# |
|
11 |
|
|
12 |
###Loading R library and packages |
|
13 |
library(gtools) # loading some useful tools |
|
14 |
library(mgcv) # GAM package by Simon Wood |
|
15 |
library(sp) # Spatial pacakge with class definition by Bivand et al. |
|
16 |
library(spdep) # Spatial pacakge with methods and spatial stat. by Bivand et al. |
|
17 |
library(rgdal) # GDAL wrapper for R, spatial utilities |
|
18 |
library(gstat) # Kriging and co-kriging by Pebesma et al. |
|
19 |
library(fields) # NCAR Spatial Interpolation methods such as kriging, splines |
|
20 |
library(raster) # Hijmans et al. package for raster processing |
|
21 |
library(gdata) # various tools with xls reading |
|
22 |
library(rasterVis) |
|
23 |
library(parallel) |
|
24 |
library(maptools) |
|
25 |
library(maps) |
|
26 |
library(reshape) |
|
27 |
library(plotrix) |
|
28 |
|
|
29 |
### Parameters and argument |
|
30 |
|
|
31 |
lc_path<-"/home/layers/data/land-cover/lc-consensus-global" |
|
32 |
infile_modis_grid<-"modis_sinusoidal_grid_world.shp" |
|
33 |
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 |
|
34 |
infile_canheight<-"Simard_Pinto_3DGlobalVeg_JGR.tif" #Canopy height |
|
35 |
#list_tiles_modis = c('h11v08','h11v07','h12v07','h12v08','h10v07','h10v08') #tile for Venezuel and surrounding area |
|
36 |
list_tiles_modis = c('h08v04','h09v04') |
|
37 |
|
|
38 |
#infile_reg_outline="" #input region outline defined by polygon |
|
39 |
infile_reg_outline= "OR83M_state_outline.shp" |
|
40 |
|
|
41 |
#CRS_interp<-"+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs"; |
|
42 |
CRS_interp <-"+proj=lcc +lat_1=43 +lat_2=45.5 +lat_0=41.75 +lon_0=-120.5 +x_0=400000 +y_0=0 +ellps=GRS80 +units=m +no_defs"; |
|
43 |
CRS_locs_WGS84<-CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +towgs84=0,0,0") #Station coords WGS84 |
|
44 |
out_region_name<-"Oregon_region" #generated on the fly |
|
45 |
out_suffix<-"_OR_04032013" |
|
46 |
ref_rast_name<- "mean_day244_rescaled.rst" #This is the shape file of outline of the study area. #local raster name defining resolution, exent, local projection--. set on the fly?? |
|
47 |
|
|
48 |
#The names of covariates can be changed...these names should be output/input from covar script!!! |
|
49 |
rnames<-c("x","y","lon","lat","N","E","N_w","E_w","elev","slope","aspect","CANHEIGHT","DISTOC") |
|
50 |
lc_names<-c("LC1","LC2","LC3","LC4","LC5","LC6","LC7","LC8","LC9","LC10","LC11","LC12") |
|
51 |
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", |
|
52 |
"nobs_01","nobs_02","nobs_03","nobs_04","nobs_05","nobs_06","nobs_07","nobs_08", |
|
53 |
"nobs_09","nobs_10","nobs_11","nobs_12") |
|
54 |
covar_names<-c(rnames,lc_names,lst_names) |
|
55 |
infile2<-"/home/layers/data/climate/ghcn/v2.92-upd-2012052822/ghcnd-stations.txt" #This is the textfile of station |
|
56 |
|
|
57 |
in_path<- "/home/parmentier/Data/IPLANT_project/Oregon_interpolation/Oregon_covariates" |
|
58 |
setwd(in_path) |
|
59 |
|
|
60 |
|
|
61 |
#################################################### |
|
62 |
#Read in GHCND database station locations |
|
63 |
|
|
64 |
dat_stat <- read.fwf(infile2, |
|
65 |
widths = c(11,9,10,7,3,31,4,4,6),fill=TRUE) |
|
66 |
colnames(dat_stat)<-c("STAT_ID","lat","lon","elev","state","name","GSNF","HCNF","WMOID") |
|
67 |
coords<- dat_stat[,c('lon','lat')] |
|
68 |
coordinates(dat_stat)<-coords |
|
69 |
proj4string(dat_stat)<-CRS_locs_WGS84 #this is the WGS84 projection |
|
70 |
#Save shapefile for later |
|
71 |
|
|
72 |
|
|
73 |
# Spatial query to find relevant stations |
|
74 |
|
|
75 |
dat_stat2<-spTransform(dat_stat,CRS(CRS_interp)) # Project from WGS84 to new coord. system |
|
76 |
|
|
77 |
#dat_stat2<-spTransform(dat_stat,CRS(CRS_interp)) # Project from WGS84 to new coord. system |
|
78 |
interp_area <- readOGR(dsn=in_path,sub(".shp","",infile_reg_outline)) |
|
79 |
|
|
80 |
inside <- !is.na(over(dat_stat2, as(interp_area, "SpatialPolygons"))) #Finding stations contained in the current interpolation area |
|
81 |
stat_reg<-dat_stat2[inside,] #Selecting stations contained in the current interpolation area |
|
82 |
|
|
83 |
#Read in world map |
|
84 |
|
|
85 |
#Get Natural Earth Data using rworldmap package: |
|
86 |
#Derived from http://www.naturalearthdata.com/downloads/110m-cultural-vectors/110m-admin-0-countries/ |
|
87 |
#world_sp <- getData("GADM", country="FRA",level=0) # different resolutions available |
|
88 |
world_sp <- getData("countries") # different resolutions available |
|
89 |
#proj4string(world_sp)<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0" |
|
90 |
#proj4string(world_sp)<-"+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs" |
|
91 |
plot(world_sp) |
|
92 |
plot(dat_stat,cex=0.2,pch=16,col=c("red"),add=TRUE) |
|
93 |
#Read in sinusoidal grid and world countries |
|
94 |
|
|
95 |
setwd(in_path) |
|
96 |
filename<-sub(".shp","",infile_modis_grid) #Removing the extension from file. |
|
97 |
modis_grid<-readOGR(".", filename) #Reading shape file using rgdal library |
|
98 |
if (infile_reg_outline!=""){ |
|
99 |
filename<-sub(".shp","",infile_reg_outline) #Removing the extension from file. |
|
100 |
reg_outline<-readOGR(".", filename) |
|
101 |
} |
|
102 |
if (infile_reg_outline==""){ |
|
103 |
reg_outline<-create_modis_tiles_region(modis_grid,list_tiles_modis) #problem...this does not |
|
104 |
#align with extent of modis LST!!! |
|
105 |
writeOGR(reg_outline,dsn= ".",layer= paste("outline",out_region_name,"_",out_suffix,sep=""), |
|
106 |
driver="ESRI Shapefile",overwrite_layer="TRUE") |
|
107 |
} |
|
108 |
|
|
109 |
create_modis_tiles_region<-function(modis_grid,tiles){ |
|
110 |
#This functions returns a subset of tiles from the modis grdi. |
|
111 |
#Arguments: modies grid tile,list of tiles |
|
112 |
#Output: spatial grid data frame of the subset of tiles |
|
113 |
h_list<-lapply(tiles,substr,start=2,stop=3) #passing multiple arguments |
|
114 |
v_list<-lapply(tiles,substr,start=5,stop=6) #passing multiple arguments |
|
115 |
selected_tiles<-subset(subset(modis_grid,subset = h %in% as.numeric (h_list) ), |
|
116 |
subset = v %in% as.numeric(v_list)) |
|
117 |
return(selected_tiles) |
|
118 |
} |
|
119 |
|
|
120 |
### READ IN COVARIATES FILES FOR OREGON AND MAKE IT A MULTI-BAND FILE |
|
121 |
|
|
122 |
inlistf<-"list_files_05032012.txt" |
|
123 |
lines<-read.table(paste(path,"/",inlistf,sep=""), sep=" ") #Column 1 contains the names of raster files |
|
124 |
inlistvar<-lines[,1] |
|
125 |
inlistvar<-paste(path,"/",as.character(inlistvar),sep="") |
|
126 |
covar_names<-as.character(lines[,2]) #Column two contains short names for covaraites |
|
127 |
|
|
128 |
s_raster<- stack(inlistvar) #Creating a stack of raster images from the list of variables. |
|
129 |
layerNames(s_raster)<-covar_names #Assigning names to the raster layers |
|
130 |
file_format<-".tif" |
|
131 |
NA_val<- -999 |
|
132 |
band_order<- "BSQ" |
|
133 |
data_name<-paste("covariates_",out_region_name,"_",sep="") |
|
134 |
raster_name<-paste(data_name,var,"_",out_suffix,file_format, sep="") |
|
135 |
#writeRaster(s_raster, filename=raster_name,NAflag=-999,bylayer=FALSE,bandorder="BSQ",overwrite=TRUE) #Writing the data in a raster file format... |
|
136 |
#if mask |
|
137 |
s_raster_m<-mask(s_raster,LC_mask,filename=raster_name, |
|
138 |
overwrite=TRUE,NAflag=NA_val,bylayer=FALSE,bandorder=band_order) |
|
139 |
#if no mask |
|
140 |
#writeRaster(s_raster, filename=raster_name,NAflag=-999,bylayer=FALSE,bandorder="BSQ",overwrite=TRUE) #Writing the data in a raster file format... |
|
141 |
|
|
142 |
#return |
|
143 |
|
|
144 |
|
|
145 |
|
|
146 |
|
|
147 |
### SCREENING FUNCTION |
|
148 |
|
|
149 |
#Screen for extreme values": this needs more thought, min and max val vary with regions |
|
150 |
#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) |
|
151 |
#r1[r1 < (min_val)]<-NA |
|
152 |
s_raster<-addLayer(s_raster,LST) #Adding current month |
|
153 |
|
|
154 |
nel<-12 |
|
155 |
#tab_range<-data.frame(varname=character(nel),varterm=character(nel),vmin=numeric(nel),vmax=numeric(nel)) |
|
156 |
val_range<-vector("list",nel) #list of one row data.frame |
|
157 |
val_rst<-vector("list",nel) #list of one row data.frame |
|
158 |
val_range[[1]]<-data.frame(varname="lon",varterm="lon",vmin=-180,vmax=180) |
|
159 |
val_range[[2]]<-data.frame(varname="lat",varterm="lat",vmin=-90,vmax=90) |
|
160 |
val_range[[3]]<-data.frame(varname="ELEV_SRTM",varterm="ELEV_SRTM",vmin=0,vmax=6000) |
|
161 |
val_range[[4]]<-data.frame(varname="Eastness",varterm="Eastness",vmin=-1,vmax=1) |
|
162 |
val_range[[5]]<-data.frame(varname="Northness",varterm="Northness",vmin=-1,vmax=1) |
|
163 |
val_range[[6]]<-data.frame(varname="Northness_w",varterm="Northness_w",vmin=-1,vmax=1) |
|
164 |
val_range[[7]]<-data.frame(varname="Eastness_w",varterm="Eastness_w",vmin=-1,vmax=1) |
|
165 |
val_range[[8]]<-data.frame(varname="mm_01",varterm="LST",vmin=-258.16,vmax=313.16) |
|
166 |
val_range[[9]]<-data.frame(varname="DISTOC",varterm="DISTOC",vmin=-0,vmax=10000000) |
|
167 |
val_range[[10]]<-data.frame(varname="LC1",varterm="LC1",vmin=0,vmax=100) |
|
168 |
val_range[[11]]<-data.frame(varname="LC3",varterm="LC3",vmin=0,vmax=100) |
|
169 |
val_range[[12]]<-data.frame(varname="slope",varterm="slope",vmin=0,vmax=90) |
|
170 |
tab_range<-do.call(rbind,val_range) |
|
171 |
#pos<-match("ELEV_SRTM",layerNames(s_raster)) #Find column with the current month for instance mm12 |
|
172 |
#ELEV_SRTM<-raster(s_raster,pos) |
|
173 |
for (k in 1:length(val_range)){ |
|
174 |
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 |
|
175 |
rclmat<-matrix(avl,ncol=3,byrow=TRUE) |
|
176 |
s_raster_r<-raster(s_raster_f,match(tab_range$varterm[k],layerNames(s_raster_f))) |
|
177 |
s_raster_r<-reclass(s_raster_r,rclmat) #Loss of layer names when using reclass |
|
178 |
layerNames(s_raster_r)<-tab_range$varterm[k] |
|
179 |
val_rst[[k]]<-s_raster_r |
|
180 |
} |
|
181 |
s_rst_m<-stack(val_rst) #This a raster stack with valid range of values |
|
182 |
|
|
183 |
|
Also available in: Unified diff
initial commit AAG2013 and transition script for continuity of results from Oregon using previous covariates brick