Project

General

Profile

« Previous | Next » 

Revision 96c5053f

Added by Benoit Parmentier over 11 years ago

GAM Fusion, Venzuela tmax interp, modification to make code more general

View differences:

climate/research/oregon/interpolation/GAM_fusion_analysis_raster_prediction_multisampling.R
10 10
#4)use seed number: use seed if random samples must be repeatable
11 11
#5)GAM fusion: possibilty of running GAM+FUSION or GAM separately 
12 12
#AUTHOR: Benoit Parmentier                                                                        
13
#DATE: 12/27/2012                                                                                 
13
#DATE: 02/06/2013                                                                                 
14 14
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#363--                                   
15 15
###################################################################################################
16 16

  
......
31 31

  
32 32
infile1<- "ghcn_or_tmax_covariates_06262012_OR83M.shp"             #GHCN shapefile containing variables for modeling 2010                 
33 33
infile2<-"list_365_dates_04212012.txt"
34
infile3<-"LST_dates_var_names.txt"                        #LST dates name
35
infile4<-"models_interpolation_05142012.txt"              #Interpolation model names
36
infile5<-"mean_day244_rescaled.rst"                       #Raster or grid for the locations of predictions
34
#infile3<-"LST_dates_var_names.txt"                        #LST dates name
35
#infile4<-"models_interpolation_05142012.txt"              #Interpolation model names
36
#infile5<-"mean_day244_rescaled.rst"                       #Raster or grid for the locations of predictions
37 37
#infile6<-"lst_climatology.txt"
38
infile6<-"LST_files_monthly_climatology.txt"
39
inlistf<-"list_files_05032012.txt"                        #Stack of images containing the Covariates
38
#infile6<-"LST_files_monthly_climatology.txt"
39
#inlistf<-"list_files_05032012.txt"                        #Stack of images containing the Covariates
40 40

  
41
path<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations_10242012_GAM"
41
infile_monthly<-"monthly_covariates_ghcn_data_TMAXy2010_2010_VE_02062013.shp"
42
infile_daily<-"daily_covariates_ghcn_data_TMAXy2010_2010_VE_02062013.shp"
43
infile_locs<-"stations_venezuela_region_y2010_2010_VE_02062013.shp"
44
infile3<-"covariates__venezuela_region__VE_01292013.tif" #this is an output from covariate script
42 45

  
43
setwd(path)
44
#Station location of the study area
45
stat_loc<-read.table(paste(path,"/","location_study_area_OR_0602012.txt",sep=""),sep=",", header=TRUE)
46
#GHCN Database for 1980-2010 for study area (OR) 
47
data3<-read.table(paste(path,"/","ghcn_data_TMAXy1980_2010_OR_0602012.txt",sep=""),sep=",", header=TRUE)
46
in_path<-"/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/input_data"
47
out_path<-"/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/output_data"
48
setwd(in_path)
48 49

  
49 50
nmodels<-9   #number of models running
50 51
y_var_name<-"dailyTmax"
......
52 53
prop<-0.3             #Proportion of testing retained for validation   
53 54
#prop<-0.25
54 55
seed_number<- 100  #if seed zero then no seed?                                                                 #Seed number for random sampling
55
out_prefix<-"_365d_GAM_fus5_all_lstd_12302012"                #User defined output prefix
56
out_prefix<-"_10d_GAM_fus5_all_lstd_020632013"                #User defined output prefix
56 57
#out_prefix<-"_365d_GAM_12272012"                #User defined output prefix
57 58

  
58 59
bias_val<-0            #if value 1 then training data is used in the bias surface rather than the all monthly stations
......
62 63
prop_max<-0.3
63 64
step<-0         
64 65
constant<-0             #if value 1 then use the same samples as date one for the all set of dates
65
#projection used in the interpolation of the study area
66
#projection used in the interpolation of the study area: should be read directly from the outline of the study area
66 67
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";
67 68
CRS_locs_WGS84<-CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +towgs84=0,0,0") #Station coords WGS84
68 69

  
69
source("GAM_fusion_function_multisampling_12302012.R")
70
source("GAM_fusion_function_multisampling_02062013.R")
70 71

  
71 72
###################### START OF THE SCRIPT ########################
72 73

  
73
###Reading the station data and setting up for models' comparison
74
filename<-sub(".shp","",infile1)             #Removing the extension from file.
75
ghcn<-readOGR(".", filename)                 #reading shapefile 
74
###Reading the daily station data and setting up for models' comparison
75
#filename<-sub(".shp","",infile1)             #Removing the extension from file.
76
#ghcn<-readOGR(".", filename)                 #reading shapefile 
77
ghcn<-readOGR(dsn=in_path,layer=sub(".shp","",infile_daily))
78
CRS_interp<-proj4string(ghcn)                       #Storing projection information (ellipsoid, datum,etc.)
76 79

  
77
CRS<-proj4string(ghcn)                       #Storing projection information (ellipsoid, datum,etc.)
80
#mean_LST<- readGDAL(infile5)                 #Reading the whole raster in memory. This provides a grid for kriging
81
#proj4string(mean_LST)<-CRS_interp                   #Assigning coordinate information to prediction grid.
78 82

  
79
mean_LST<- readGDAL(infile5)                 #Reading the whole raster in memory. This provides a grid for kriging
80
proj4string(mean_LST)<-CRS                   #Assigning coordinate information to prediction grid.
83
#Station location of the study area
84
#stat_loc<-read.table(paste(path,"/","location_study_area_OR_0602012.txt",sep=""),sep=",", header=TRUE)
85
stat_loc<-readOGR(dsn=in_path,layer=sub(".shp","",infile_locs))
81 86

  
82
ghcn <- transform(ghcn,Northness = cos(ASPECT*pi/180)) #Adding a variable to the dataframe
83
ghcn <- transform(ghcn,Eastness = sin(ASPECT*pi/180))  #adding variable to the dataframe.
84
ghcn <- transform(ghcn,Northness_w = sin(slope*pi/180)*cos(ASPECT*pi/180)) #Adding a variable to the dataframe
85
ghcn <- transform(ghcn,Eastness_w = sin(slope*pi/180)*sin(ASPECT*pi/180))  #adding variable to the dataframe.
87
#GHCN Database for 1980-2010 for study area (OR) 
88
#data3<-read.table(paste(path,"/","ghcn_data_TMAXy1980_2010_OR_0602012.txt",sep=""),sep=",", header=TRUE)
89
#data3<-file.path(in_path,infile_monthly)
90
data3<-readOGR(dsn=in_path,layer=sub(".shp","",infile_monthly))
86 91

  
87
#Remove NA for LC and CANHEIGHT
92
#Remove NA for LC and CANHEIGHT: Need to check this part
88 93
ghcn$LC1[is.na(ghcn$LC1)]<-0
89 94
ghcn$LC3[is.na(ghcn$LC3)]<-0
90 95
ghcn$CANHEIGHT[is.na(ghcn$CANHEIGHT)]<-0
91 96
ghcn$LC4[is.na(ghcn$LC4)]<-0
92 97
ghcn$LC6[is.na(ghcn$LC6)]<-0
93 98

  
94
dates <-readLines(paste(path,"/",infile2, sep=""))
95
LST_dates <-readLines(paste(path,"/",infile3, sep=""))
96
models <-readLines(paste(path,"/",infile4, sep=""))
99
dates <-readLines(paste(file.path(in_path,infile2))
100
#LST_dates <-readLines(file.path(in_path,infile3))
101
#models <-readLines(paste(path,"/",infile4, sep=""))
97 102

  
98 103
##Extracting the variables values from the raster files                                             
99 104

  
100
lines<-read.table(paste(path,"/",inlistf,sep=""), sep=" ")                  #Column 1 contains the names of raster files
101
inlistvar<-lines[,1]
102
inlistvar<-paste(path,"/",as.character(inlistvar),sep="")
103
covar_names<-as.character(lines[,2])                                         #Column two contains short names for covaraites
104

  
105
s_raster<- stack(inlistvar)                                                  #Creating a stack of raster images from the list of variables.
106
layerNames(s_raster)<-covar_names                                            #Assigning names to the raster layers
107
projection(s_raster)<-CRS
108

  
109
#stat_val<- extract(s_raster, ghcn3)                                          #Extracting values from the raster stack for every point location in coords data frame.
110
pos<-match("ASPECT",layerNames(s_raster)) #Find column with name "value"
111
r1<-raster(s_raster,layer=pos)             #Select layer from stack
112
pos<-match("slope",layerNames(s_raster)) #Find column with name "value"
113
r2<-raster(s_raster,layer=pos)             #Select layer from stack
114
N<-cos(r1*pi/180)
115
E<-sin(r1*pi/180)
116
Nw<-sin(r2*pi/180)*cos(r1*pi/180)   #Adding a variable to the dataframe
117
Ew<-sin(r2*pi/180)*sin(r1*pi/180)   #Adding variable to the dataframe.
118

  
105
#The names of covariates can be changed...
106
rnames<-c("x","y","lon","lat","N","E","N_w","E_w","elev","slope","aspect","CANHEIGHT","DISTOC")
107
lc_names<-c("LC1","LC2","LC3","LC4","LC5","LC6","LC7","LC8","LC9","LC10","LC11","LC12")
108
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",
109
                    "nobs_01","nobs_02","nobs_03","nobs_04","nobs_05","nobs_06","nobs_07","nobs_08",
110
                    "nobs_09","nobs_10","nobs_11","nobs_12")
111
                  
112
covar_names<-c(rnames,lc_names,lst_names)
113
                  
114
s_raster<-stack(infile3)                   #read in the data stack
115
names(s_raster)<-covar_names               #Assigning names to the raster layers: making sure it is included in the extraction
116

  
117
#Deal with no data value and zero      
119 118
pos<-match("LC1",layerNames(s_raster)) #Find column with name "value"
120 119
LC1<-raster(s_raster,layer=pos)             #Select layer from stack
121 120
s_raster<-dropLayer(s_raster,pos)
......
126 125
s_raster<-dropLayer(s_raster,pos)
127 126
LC3[is.na(LC3)]<-0
128 127

  
129
pos<-match("LC4",layerNames(s_raster)) #Find column with name "value"
130
LC4<-raster(s_raster,layer=pos)             #Select layer from stack
131
s_raster<-dropLayer(s_raster,pos)
132
LC4[is.na(LC4)]<-0
133

  
134
pos<-match("LC6",layerNames(s_raster)) #Find column with name "value"
135
LC6<-raster(s_raster,layer=pos)             #Select layer from stack
136
s_raster<-dropLayer(s_raster,pos)
137
LC6[is.na(LC6)]<-0
138

  
139
LC_s<-stack(LC1,LC3,LC4,LC6)
140
layerNames(LC_s)<-c("LC1_forest","LC3_grass","LC4_crop","LC6_urban")
141
plot(LC_s)
142

  
143 128
pos<-match("CANHEIGHT",layerNames(s_raster)) #Find column with name "value"
144 129
CANHEIGHT<-raster(s_raster,layer=pos)             #Select layer from stack
145 130
s_raster<-dropLayer(s_raster,pos)
......
149 134
s_raster<-dropLayer(s_raster,pos)
150 135
ELEV_SRTM[ELEV_SRTM <0]<-NA
151 136

  
152
xy<-coordinates(r1)  #get x and y projected coordinates...
153
xy_latlon<-project(xy, CRS, inv=TRUE) # find lat long for projected coordinats (or pixels...)
154
lon<-raster(xy_latlon) #Transform a matrix into a raster object ncol=ncol(r1), nrow=nrow(r1))
155
ncol(lon)<-ncol(r1)
156
nrow(lon)<-nrow(r1)
157
extent(lon)<-extent(r1)
158
projection(lon)<-CRS  #At this stage this is still an empty raster with 536 nrow and 745 ncell 
159
lat<-lon
160
values(lon)<-xy_latlon[,1]
161
values(lat)<-xy_latlon[,2]
162

  
163
r<-stack(N,E,Nw,Ew,lon,lat,LC1,LC3,LC4,LC6, CANHEIGHT,ELEV_SRTM)
164
rnames<-c("Northness","Eastness","Northness_w","Eastness_w", "lon","lat","LC1","LC3","LC4","LC6","CANHEIGHT","ELEV_SRTM")
165
layerNames(r)<-rnames
166
s_raster<-addLayer(s_raster, r)
167

  
168 137
#s_sgdf<-as(s_raster,"SpatialGridDataFrame") #Conversion to spatial grid data frame
169 138

  
170 139
####### Preparing LST stack of climatology...
......
199 168

  
200 169
# do this work outside of (before) this function
201 170
# to avoid making a copy of the data frame inside the function call
202
date1<-ISOdate(data3$year,data3$month,data3$day) #Creating a date object from 3 separate column
203
date2<-as.POSIXlt(as.Date(date1))
204
data3$date<-date2
205
d<-subset(data3,year>=2000 & mflag=="0" ) #Selecting dataset 2000-2010 with good quality: 193 stations
206
#May need some screeing??? i.e. range of temp and elevation...
207
d1<-aggregate(value~station+month, data=d, mean)  #Calculate monthly mean for every station in OR
208
id<-as.data.frame(unique(d1$station))     #Unique station in OR for year 2000-2010: 193 but 7 loss of monthly avg    
209

  
210
dst<-merge(d1, stat_loc, by.x="station", by.y="STAT_ID")   #Inner join all columns are retained
211

  
212
#This allows to change only one name of the data.frame
213
pos<-match("value",names(dst)) #Find column with name "value"
214
names(dst)[pos]<-c("TMax")
215
dst$TMax<-dst$TMax/10                #TMax is the average max temp for monthy data
216
#dstjan=dst[dst$month==9,]  #dst contains the monthly averages for tmax for every station over 2000-2010
217

  
218
#Extracting covariates from stack
219
coords<- dst[c('lon','lat')]              #Define coordinates in a data frame
220
coordinates(dst)<-coords                      #Assign coordinates to the data frame
221
proj4string(dst)<-CRS_locs_WGS84                  #Assign coordinates reference system in PROJ4 format
222
dst_month<-spTransform(dst,CRS(CRS_interp))     #Project from WGS84 to new coord. system
223

  
224
stations_val<-extract(s_raster,dst_month)  #extraction of the infomration at station location
225
stations_val<-as.data.frame(stations_val)
226
dst_extract<-cbind(dst_month,stations_val)
227
dst<-dst_extract
171
# date1<-ISOdate(data3$year,data3$month,data3$day) #Creating a date object from 3 separate column
172
# date2<-as.POSIXlt(as.Date(date1))
173
# data3$date<-date2
174
# d<-subset(data3,year>=2000 & mflag=="0" ) #Selecting dataset 2000-2010 with good quality: 193 stations
175
# #May need some screeing??? i.e. range of temp and elevation...
176
# d1<-aggregate(value~station+month, data=d, mean)  #Calculate monthly mean for every station in OR
177
# id<-as.data.frame(unique(d1$station))     #Unique station in OR for year 2000-2010: 193 but 7 loss of monthly avg    
178
# 
179
# dst<-merge(d1, stat_loc, by.x="station", by.y="STAT_ID")   #Inner join all columns are retained
180
# 
181
# #This allows to change only one name of the data.frame
182
# pos<-match("value",names(dst)) #Find column with name "value"
183
# names(dst)[pos]<-c("TMax")
184
# dst$TMax<-dst$TMax/10                #TMax is the average max temp for monthy data
185
# #dstjan=dst[dst$month==9,]  #dst contains the monthly averages for tmax for every station over 2000-2010
186
# 
187
# #Extracting covariates from stack
188
# coords<- dst[c('lon','lat')]              #Define coordinates in a data frame
189
# coordinates(dst)<-coords                      #Assign coordinates to the data frame
190
# proj4string(dst)<-CRS_locs_WGS84                  #Assign coordinates reference system in PROJ4 format
191
# dst_month<-spTransform(dst,CRS(CRS_interp))     #Project from WGS84 to new coord. system
192
# 
193
# stations_val<-extract(s_raster,dst_month)  #extraction of the infomration at station location
194
# stations_val<-as.data.frame(stations_val)
195
# dst_extract<-cbind(dst_month,stations_val)
196
# dst<-dst_extract
197
                  
228 198
#Now clean and screen monthly values
229
dst_all<-dst
230
dst<-subset(dst,dst$TMax>-15 & dst$TMax<40)
231
dst<-subset(dst,dst$ELEV_SRTM>0) #This will drop two stations...or 24 rows
199
#dst_all<-dst
200
dst_all<-data3
201
dst<-data3
202
#dst<-subset(dst,dst$TMax>-15 & dst$TMax<45) #may choose different threshold??
203
#dst<-subset(dst,dst$ELEV_SRTM>0) #This will drop two stations...or 24 rows
232 204

  
233 205
######### Preparing daily values for training and testing
234

  
206
                  
235 207
#Screening for bad values: value is tmax in this case
236 208
#ghcn$value<-as.numeric(ghcn$value)
237
ghcn_all<-ghcn
238
ghcn_test<-subset(ghcn,ghcn$value>-150 & ghcn$value<400)
239
ghcn_test2<-subset(ghcn_test,ghcn_test$ELEV_SRTM>0)
240
ghcn<-ghcn_test2
209
#ghcn_all<-ghcn
210
#ghcn_test<-subset(ghcn,ghcn$value>-150 & ghcn$value<400)
211
#ghcn_test<-ghcn
212
#ghcn_test2<-subset(ghcn_test,ghcn_test$elev_1>0)
213
#ghcn<-ghcn_test2
241 214
#coords<- ghcn[,c('x_OR83M','y_OR83M')]
242 215

  
243 216
##Sampling: training and testing sites.
244 217

  
218
#Make this a a function
219
                  
245 220
if (seed_number>0) {
246 221
  set.seed(seed_number)                        #Using a seed number allow results based on random number to be compared...
247 222
}

Also available in: Unified diff