Project

General

Profile

Download (25.1 KB) Statistics
| Branch: | Revision:
1
##################    CLIMATE INTERPOLATION FUSION METHOD   #######################################
2
############################ Merging LST and station data ##########################################
3
#This script interpolates tmax values using MODIS LST and GHCND station data                     #
4
#interpolation area. It requires the text file of stations and a shape file of the study area.   #       
5
#Note that the projection for both GHCND and study area is lonlat WGS84.                         #
6
#AUTHOR: Brian McGill                                                                            #
7
#DATE: 06/19/212                                                                                 #
8
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#363--                                  #
9
###################################################################################################
10

    
11
###Loading R library and packages                                                      
12
library(gtools)                                         # loading some useful tools 
13
library(mgcv)                                           # GAM package by Simon Wood
14
library(sp)                                             # Spatial pacakge with class definition by Bivand et al.
15
library(spdep)                               # Spatial pacakge with methods and spatial stat. by Bivand et al.
16
library(rgdal)                               # GDAL wrapper for R, spatial utilities
17
library(gstat)                               # Kriging and co-kriging by Pebesma et al.
18
library(fields)                              # NCAR Spatial Interpolation methods such as kriging, splines
19
library(raster)                              # Hijmans et al. package for raster processing
20
### Parameters and argument
21

    
22
infile1<- "ghcn_or_tmax_covariates_06262012_OR83M.shp"             #GHCN shapefile containing variables for modeling 2010                 
23
infile2<-"list_10_dates_04212012.txt"                     #List of 10 dates for the regression
24
#infile2<-"list_365_dates_04212012.txt"
25
infile3<-"LST_dates_var_names.txt"                        #LST dates name
26
infile4<-"models_interpolation_05142012.txt"              #Interpolation model names
27
infile5<-"mean_day244_rescaled.rst"                       #Raster or grid for the locations of predictions
28

    
29
#path<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations"
30
path<-"M:/Data/IPLANT_project/data_Oregon_stations"   #Locations on Atlas
31

    
32
#Station location of the study area
33
stat_loc<-read.table(paste(path,"/","location_study_area_OR_0602012.txt",sep=""),sep=",", header=TRUE)
34
#GHCN Database for 1980-2010 for study area (OR) 
35
data3<-read.table(paste(path,"/","ghcn_data_TMAXy1980_2010_OR_0602012.txt",sep=""),sep=",", header=TRUE)
36

    
37
prop<-0.3                                                                           #Proportion of testing retained for validation   
38
#prop<-0.25
39
seed_number<- 100                                                                   #Seed number for random sampling
40
out_prefix<-"_07022012_10d_fusion12"                                                   #User defined output prefix
41
setwd(path)
42
############ START OF THE SCRIPT ##################
43

    
44
#
45
### Step 0/Step 6 in Brian's code...preparing year 2010 data for modeling 
46
#
47

    
48

    
49
###Reading the station data and setting up for models' comparison
50
filename<-sub(".shp","",infile1)             #Removing the extension from file.
51
ghcn<-readOGR(".", filename)                 #reading shapefile 
52

    
53
CRS<-proj4string(ghcn)                       #Storing projection information (ellipsoid, datum,etc.)
54

    
55
mean_LST<- readGDAL(infile5)                 #Reading the whole raster in memory. This provides a grid for kriging
56
proj4string(mean_LST)<-CRS                   #Assigning coordinate information to prediction grid.
57

    
58
ghcn = transform(ghcn,Northness = cos(ASPECT*pi/180)) #Adding a variable to the dataframe
59
#ghcn = transform(ghcn,Northness = cos(ASPECT)) #Adding a variable to the dataframe
60
#ghcn = transform(ghcn,Eastness = sin(ASPECT))  #adding variable to the dataframe.
61
ghcn = transform(ghcn,Eastness = sin(ASPECT*pi/180))  #adding variable to the dataframe.
62
#ghcn = transform(ghcn,Northness_w = sin(slope)*cos(ASPECT)) #Adding a variable to the dataframe
63
#ghcn = transform(ghcn,Eastness_w = sin(slope)*sin(ASPECT))  #adding variable to the dataframe.
64
ghcn = transform(ghcn,Northness_w = sin(slope*pi/180)*cos(ASPECT*pi/180)) #Adding a variable to the dataframe
65
ghcn = transform(ghcn,Eastness_w = sin(slope*pi/180)*sin(ASPECT*pi/180))  #adding variable to the dataframe.
66

    
67
#Remove NA for LC and CANHEIGHT
68
ghcn$LC1[is.na(ghcn$LC1)]<-0
69
ghcn$LC3[is.na(ghcn$LC3)]<-0
70
ghcn$CANHEIGHT[is.na(ghcn$CANHEIGHT)]<-0
71

    
72

    
73
set.seed(seed_number)                        #Using a seed number allow results based on random number to be compared...
74

    
75
dates <-readLines(paste(path,"/",infile2, sep=""))
76
LST_dates <-readLines(paste(path,"/",infile3, sep=""))
77
models <-readLines(paste(path,"/",infile4, sep=""))
78

    
79
#Model assessment: specific diagnostic/metrics for GAM
80
results_AIC<- matrix(1,length(dates),length(models)+3)  
81
results_GCV<- matrix(1,length(dates),length(models)+3)
82
results_DEV<- matrix(1,length(dates),length(models)+3)
83
results_RMSE_f<- matrix(1,length(dates),length(models)+3)
84

    
85
#Model assessment: general diagnostic/metrics 
86
results_RMSE <- matrix(1,length(dates),length(models)+4)
87
results_MAE <- matrix(1,length(dates),length(models)+4)
88
results_ME <- matrix(1,length(dates),length(models)+4)       #There are 8+1 models
89
results_R2 <- matrix(1,length(dates),length(models)+4)       #Coef. of determination for the validation dataset
90
results_RMSE_f<- matrix(1,length(dates),length(models)+4)    #RMSE fit, RMSE for the training dataset
91
results_RMSE_f_kr<- matrix(1,length(dates),length(models)+4)
92

    
93
# #Tracking relationship between LST AND LC
94
# cor_LST_LC1<-matrix(1,10,1)      #correlation LST-LC1
95
# cor_LST_LC3<-matrix(1,10,1)      #correlation LST-LC3
96
# cor_LST_tmax<-matrix(1,10,1)     #correlation LST-tmax
97

    
98
#Screening for bad values: value is tmax in this case
99
#ghcn$value<-as.numeric(ghcn$value)
100
ghcn_all<-ghcn
101
ghcn_test<-subset(ghcn,ghcn$value>-150 & ghcn$value<400)
102
ghcn_test2<-subset(ghcn_test,ghcn_test$ELEV_SRTM>0)
103
ghcn<-ghcn_test2
104
#coords<- ghcn[,c('x_OR83M','y_OR83M')]
105

    
106
month_var<-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")
107
ghcn.subsets <-lapply(dates, function(d) subset(ghcn, date==d)) #this creates a list of 10 or 365 subsets dataset based on dates
108

    
109

    
110
#Start loop here...
111

    
112
## looping through the dates...this is the main part of the code
113
#i=1 #for debugging
114
#j=1 #for debugging
115
for(i in 1:length(dates)){            # start of the for loop #1
116
  
117
  date<-strptime(dates[i], "%Y%m%d")   # interpolation date being processed
118
  month<-strftime(date, "%m")          # current month of the date being processed
119
  LST_month<-paste("mm_",month,sep="") # name of LST month to be matched
120
  
121
  ###Regression part 1: Creating a validation dataset by creating training and testing datasets
122
  
123
  mod_LST <-ghcn.subsets[[i]][,match(LST_month, names(ghcn.subsets[[i]]))]  #Match interpolation date and monthly LST average
124
  ghcn.subsets[[i]] = transform(ghcn.subsets[[i]],LST = mod_LST)            #Add the variable LST to the subset dataset
125
  n<-nrow(ghcn.subsets[[i]])
126
  ns<-n-round(n*prop)   #Create a sample from the data frame with 70% of the rows
127
  nv<-n-ns              #create a sample for validation with prop of the rows
128
  ind.training <- sample(nrow(ghcn.subsets[[i]]), size=ns, replace=FALSE) #This selects the index position for 70% of the rows taken randomly
129
  ind.testing <- setdiff(1:nrow(ghcn.subsets[[i]]), ind.training)
130
  data_s <- ghcn.subsets[[i]][ind.training, ]   #Training dataset currently used in the modeling
131
  data_v <- ghcn.subsets[[i]][ind.testing, ]    #Testing/validation dataset
132
  
133
  #i=1
134
  date_proc<-dates[i]
135
  date_proc<-strptime(dates[i], "%Y%m%d")   # interpolation date being processed
136
  mo<-as.integer(strftime(date_proc, "%m"))          # current month of the date being processed
137
  day<-as.integer(strftime(date_proc, "%d"))
138
  year<-as.integer(strftime(date_proc, "%Y"))
139
  
140
  #setup
141
  
142
  #mo=9           #Commented out by Benoit on June 14
143
  #day=2
144
  #year=2010
145
  datelabel=format(ISOdate(year,mo,day),"%b %d, %Y")
146
  
147
  ###########
148
  #  STEP 1 - 10 year monthly averages
149
  ###########
150
  
151
  #library(raster)
152
  #old<-getwd()
153
  #setwd("c:/data/benoit/data_Oregon_stations_Brian_04242012")
154
  #l=list.files(pattern="mean_month.*rescaled.tif")
155
  l=list.files(pattern="mean_month.*rescaled.rst")
156
  molst<-stack(l)  #Creating a raster stack...
157
  #setwd(old)
158
  molst=molst-273.16  #K->C
159
  idx <- seq(as.Date('2010-01-15'), as.Date('2010-12-15'), 'month')
160
  molst <- setZ(molst, idx)
161
  layerNames(molst) <- month.abb
162
  themolst<-raster(molst,mo) #current month being processed saved in a raster image
163
  plot(themolst)
164
  
165
  ###########
166
  # STEP 2 - Weather station means across same days: Monthly mean calculation
167
  ###########
168
  
169
  # ??? which years & what quality flags???
170
  #select ghcn.id, lat,lon, elev, month, avg(value/10) as "TMax", count(*) as "NumDays" from ghcn, stations where ghcn.id in (select id from stations where state=='OR') and ghcn.id==stations.id and value<>-9999 and year>=2000 and  element=='TMAX' group by stations.id, month;select ghcn.id, lat,lon, elev, month, avg(value/10) as "TMax", count(*) as "NumDays" from ghcn, stations where ghcn.id in (select id from stations where state=='OR') and ghcn.id==stations.id and value<>-9999 and year>=2000 and  element=='TMAX' group by stations.id, month;
171
  #below table from above SQL query
172
  #dst<-read.csv('/data/benoit/data_oregon_stations_brian_04242012/station_means.csv',h=T)
173
  
174
  ##Added by Benoit ######
175
  date1<-ISOdate(data3$year,data3$month,data3$day) #Creating a date object from 3 separate column
176
  date2<-as.POSIXlt(as.Date(date1))
177
  data3$date<-date2
178
  d<-subset(data3,year>=2000 & mflag=="0" ) #Selecting dataset 2000-2010 with good quality
179
  #May need some screeing??? i.e. range of temp and elevation...
180
  d1<-aggregate(value~station+month, data=d, mean)  #Calculate monthly mean for every station in OR
181
  id<-as.data.frame(unique(d1$station))     #Unique station in OR for year 2000-2010      
182
  
183
  dst<-merge(d1, stat_loc, by.x="station", by.y="STAT_ID")   #Inner join all columns are retained
184
 
185
  #This allows to change only one name of the data.frame
186
  pos<-match("value",names(dst)) #Find column with name "value"
187
  names(dst)[pos]<-c("TMax")
188
  dst$TMax<-dst$TMax/10                #TMax is the average max temp for months
189
  #dstjan=dst[dst$month==9,]  #dst contains the monthly averages for tmax for every station over 2000-2010
190
  ##############
191
  
192
  modst=dst[dst$month==mo,] #Subsetting dataset for the relevnat month of the date being processed
193
  
194
  ##########
195
  # STEP 3 - get LST at stations
196
  ##########
197
  
198
  sta_lola=modst[,c("lon","lat")] #Extracting locations of stations for the current month...
199
  library(rgdal)
200
  proj_str="+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";
201
  lookup<-function(r,lat,lon) {
202
    xy<-project(cbind(lon,lat),proj_str);
203
    cidx<-cellFromXY(r,xy);
204
    return(r[cidx])
205
  }
206
  sta_tmax_from_lst=lookup(themolst,sta_lola$lat,sta_lola$lon) #Extracted values of LST for the stations
207
  
208
  #########
209
  # STEP 4 - bias at stations     
210
  #########
211
  
212
  sta_bias=sta_tmax_from_lst-modst$TMax; #That is the difference between the monthly LST mean and monthly station mean
213
  #Added by Benoit
214
  modst$LSTD_bias<-sta_bias  #Adding bias to data frame modst containning the monthly average for 10 years
215
  
216
  bias_xy=project(as.matrix(sta_lola),proj_str)
217
  # windows()
218
  X11()
219
  plot(modst$TMax,sta_tmax_from_lst,xlab="Station mo Tmax",ylab="LST mo Tmax",main=paste("LST vs TMax for",datelabel,sep=" "))
220
  abline(0,1)
221
  savePlot(paste("LST_TMax_scatterplot_",dates[i],out_prefix,".png", sep=""), type="png")
222
  dev.off()
223
  
224
  ########
225
  # STEP 5 - interpolate bias
226
  ########
227
  
228
  # ?? include covariates like elev, distance to coast, cloud frequency, tree height
229
  #library(fields)
230
  #windows()
231
  quilt.plot(sta_lola,sta_bias,main="Bias at stations",asp=1)
232
  US(add=T,col="magenta",lwd=2)
233
  #fitbias<-Tps(bias_xy,sta_bias) #use TPS or krige
234
  fitbias<-Krig(bias_xy,sta_bias,theta=1e5) #use TPS or krige 
235
                                            #The output is a krig object using fields
236
  # Creating plot of bias surface and saving it
237
  X11()
238
  datelabel2=format(ISOdate(year,mo,day),"%B ") #added by Benoit, label
239
  surface(fitbias,col=rev(terrain.colors(100)),asp=1,main=paste("Interpolated bias for",datelabel2,sep=" "))
240
  savePlot(paste("Bias_surface_LST_TMax_",dates[i],out_prefix,".png", sep=""), type="png")
241
  dev.off()
242
  
243
  #US(add=T,col="magenta",lwd=2)
244
  
245
  ##########
246
  # STEP 6 - return to daily station data & calcualate delta=daily T-monthly T from stations
247
  ##########
248
  
249
  #Commmented out by Benoit 06/14
250
  # library(RSQLite)
251
  # m<-dbDriver("SQLite")
252
  # con<-dbConnect(m,dbname='c:/data/ghcn_tmintmax.db')
253
  # querystr=paste("select ghcn.id, value as 'dailyTmax' from ghcn where ghcn.id in (select id from stations where state=='OR') and value<>-9999",
254
  #    "and year==",year,"and month==",mo,"and day==",day,
255
  #                "and element=='TMAX' ")
256
  # rs<-dbSendQuery(con,querystr)
257
  # d<-fetch(rs,n=-1)
258
  # dbClearResult(rs)
259
  # dbDisconnect(con)
260
  # 
261
  # d$dailyTmax=d$dailyTmax/10 #stored as 1/10 degree C to allow integer storage
262
  # dmoday=merge(modst,d,by="id")
263
  ##########################Commented out by Benoit
264
  
265
  #added by Benoit 
266
  #x<-ghcn.subsets[[i]]  #Holds both training and testing for instance 161 rows for Jan 1
267
  x<-data_v
268
  d<-data_s
269
  
270
  pos<-match("value",names(d)) #Find column with name "value"
271
  names(d)[pos]<-c("dailyTmax")
272
  names(x)[pos]<-c("dailyTmax")
273
  d$dailyTmax=(as.numeric(d$dailyTmax))/10 #stored as 1/10 degree C to allow integer storage
274
  x$dailyTmax=(as.numeric(x$dailyTmax))/10 #stored as 1/10 degree C to allow integer storage
275
  pos<-match("station",names(d)) #Find column with name "value"
276
  names(d)[pos]<-c("id")
277
  names(x)[pos]<-c("id")
278
  names(modst)[1]<-c("id")       #modst contains the average tmax per month for every stations...
279
  dmoday=merge(modst,d,by="id")  #LOOSING DATA HERE!!! from 113 t0 103
280
  xmoday=merge(modst,x,by="id")  #LOOSING DATA HERE!!! from 48 t0 43
281
  names(dmoday)[4]<-c("lat")
282
  names(dmoday)[5]<-c("lon")     #dmoday contains all the the information: BIAS, monn
283
  names(xmoday)[4]<-c("lat")
284
  names(xmoday)[5]<-c("lon")     #dmoday contains all the the information: BIAS, monn
285
  
286
  data_v<-xmoday
287
  ###
288
  
289
  #dmoday contains the daily tmax values with TMax being the monthly station tmax mean
290
  #dmoday contains the daily tmax values with TMax being the monthly station tmax mean
291
  
292
  # windows()
293
  X11()
294
  plot(dailyTmax~TMax,data=dmoday,xlab="Mo Tmax",ylab=paste("Daily for",datelabel),main="across stations in OR")
295
  savePlot(paste("Daily_tmax_monthly_TMax_scatterplot_",dates[i],out_prefix,".png", sep=""), type="png")
296
  dev.off()
297
  ##########
298
  # STEP 7 - interpolate delta across space
299
  ##########
300
  
301
  daily_sta_lola=dmoday[,c("lon","lat")] #could be same as before but why assume merge does this - assume not
302
  daily_sta_xy=project(as.matrix(daily_sta_lola),proj_str)
303
  daily_delta=dmoday$dailyTmax-dmoday$TMax
304
  #windows()
305
  quilt.plot(daily_sta_lola,daily_delta,asp=1,main="Station delta for Jan 15")
306
  US(add=T,col="magenta",lwd=2)
307
  #fitdelta<-Tps(daily_sta_xy,daily_delta) #use TPS or krige
308
  fitdelta<-Krig(daily_sta_xy,daily_delta,theta=1e5) #use TPS or krige
309
                                                     #Kriging using fields package
310
 
311
  # Creating plot of bias surface and saving it
312
  X11()
313
  surface(fitdelta,col=rev(terrain.colors(100)),asp=1,main=paste("Interpolated delta for",datelabel,sep=" "))
314
  savePlot(paste("Delta_surface_LST_TMax_",dates[i],out_prefix,".png", sep=""), type="png")
315
  dev.off()
316
  #US(add=T,col="magenta",lwd=2)
317
  #
318
  
319
  #### Added by Benoit on 06/19
320
  data_s<-dmoday #put the 
321
  data_s$daily_delta<-daily_delta
322
  
323
  
324
  #data_s$y_var<-daily_delta  #y_var is the variable currently being modeled, may be better with BIAS!!
325
  data_s$y_var<-data_s$LSTD_bias
326
  #data_s$y_var<-(data_s$dailyTmax)*10
327
  #Model and response variable can be changed without affecting the script
328
  
329
  mod1<- gam(y_var~ s(lat) + s (lon) + s (ELEV_SRTM), data=data_s)
330
  mod2<- gam(y_var~ s(lat,lon)+ s(ELEV_SRTM), data=data_s) #modified nesting....from 3 to 2
331
  mod3<- gam(y_var~ s(lat) + s (lon) + s (ELEV_SRTM) +  s (Northness)+ s (Eastness) + s(DISTOC), data=data_s)
332
  mod4<- gam(y_var~ s(lat) + s (lon) + s(ELEV_SRTM) + s(Northness) + s (Eastness) + s(DISTOC) + s(LST), data=data_s)
333
  mod5<- gam(y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST), data=data_s)
334
  mod6<- gam(y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC1), data=data_s)
335
  mod7<- gam(y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST)+s(LC3), data=data_s)
336
  mod8<- gam(y_var~ s(lat,lon) +s(ELEV_SRTM) + s(Northness,Eastness) + s(DISTOC) + s(LST) + s(LC1), data=data_s)
337
 
338
  #Added
339
  #tmax_predicted=themolst+daily_delta_rast-bias_rast #Final surface?? but daily_rst
340
  
341
  #### Added by Benoit ends
342

    
343
  #########
344
  # STEP 8 - assemble final answer - T=LST+Bias(interpolated)+delta(interpolated)
345
  #########
346
  
347
  bias_rast=interpolate(themolst,fitbias) #interpolation using function from raster package
348
                                          #themolst is raster layer, fitbias is "Krig" object from bias surface
349
  plot(bias_rast,main="Raster bias") #This not displaying...
350
  
351
  daily_delta_rast=interpolate(themolst,fitdelta) #Interpolation of the bias surface...
352
  
353
  plot(daily_delta_rast,main="Raster Daily Delta")
354
  
355
  tmax_predicted=themolst+daily_delta_rast-bias_rast #Final surface  as a raster layer...
356
  #tmax_predicted=themolst+daily_delta_rast+bias_rast #Added by Benoit, why is it -bias_rast
357
  plot(tmax_predicted,main="Predicted daily")
358
  
359
  ########
360
  # check: assessment of results: validation
361
  ########
362
  RMSE<-function(x,y) {return(mean((x-y)^2)^0.5)}
363
  
364
  #FIT ASSESSMENT
365
  sta_pred_data_s=lookup(tmax_predicted,data_s$lat,data_s$lon)
366
  rmse_fit=RMSE(sta_pred_data_s,data_s$dailyTmax)
367
  
368
  sta_pred=lookup(tmax_predicted,data_v$lat,data_v$lon)
369
  #sta_pred=lookup(tmax_predicted,daily_sta_lola$lat,daily_sta_lola$lon)
370
  #rmse=RMSE(sta_pred,dmoday$dailyTmax)
371
  #pos<-match("value",names(data_v)) #Find column with name "value"
372
  #names(data_v)[pos]<-c("dailyTmax")
373
  tmax<-data_v$dailyTmax
374
  #data_v$dailyTmax<-tmax
375
  rmse=RMSE(sta_pred,tmax)
376
  #plot(sta_pred~dmoday$dailyTmax,xlab=paste("Actual daily for",datelabel),ylab="Pred daily",main=paste("RMSE=",rmse))
377
  X11()
378
  plot(sta_pred~tmax,xlab=paste("Actual daily for",datelabel),ylab="Pred daily",main=paste("RMSE=",rmse))
379
  abline(0,1)
380
  savePlot(paste("Predicted_tmax_versus_observed_scatterplot_",dates[i],out_prefix,".png", sep=""), type="png")
381
  dev.off()
382
  #resid=sta_pred-dmoday$dailyTmax
383
  resid=sta_pred-tmax
384
  quilt.plot(daily_sta_lola,resid)
385
  
386
  ### END OF BRIAN's code
387
  
388
  ### Added by benoit
389
  #Store results using TPS
390
  j=9
391
  results_RMSE[i,1]<- dates[i]    #storing the interpolation dates in the first column
392
  results_RMSE[i,2]<- ns          #number of stations used in the training stage
393
  results_RMSE[i,3]<- "RMSE"
394
  results_RMSE[i,j+3]<- rmse  #Storing RMSE for the model j
395
  
396
  results_RMSE_f[i,1]<- dates[i]    #storing the interpolation dates in the first column
397
  results_RMSE_f[i,2]<- ns          #number of stations used in the training stage
398
  results_RMSE_f[i,3]<- "RMSE"
399
  results_RMSE_f[i,j+3]<- rmse_fit  #Storing RMSE for the model j
400
  
401
  ns<-nrow(data_s) #This is added to because some loss of data might have happened because of the averaging...
402
  nv<-nrow(data_v)         
403
  
404
  for (j in 1:length(models)){
405
    
406
    ##Model assessment: specific diagnostic/metrics for GAM
407
    
408
    name<-paste("mod",j,sep="")  #modj is the name of The "j" model (mod1 if j=1) 
409
    mod<-get(name)               #accessing GAM model ojbect "j"
410
    results_AIC[i,1]<- dates[i]  #storing the interpolation dates in the first column
411
    results_AIC[i,2]<- ns        #number of stations used in the training stage
412
    results_AIC[i,3]<- "AIC"
413
    results_AIC[i,j+3]<- AIC (mod)
414
    
415
    results_GCV[i,1]<- dates[i]  #storing the interpolation dates in the first column
416
    results_GCV[i,2]<- ns        #number of stations used in the training 
417
    results_GCV[i,3]<- "GCV"
418
    results_GCV[i,j+3]<- mod$gcv.ubre
419
    
420
    results_DEV[i,1]<- dates[i]  #storing the interpolation dates in the first column
421
    results_DEV[i,2]<- ns        #number of stations used in the training stage
422
    results_DEV[i,3]<- "DEV"
423
    results_DEV[i,j+3]<- mod$deviance
424
    
425
    sta_LST_s=lookup(themolst,data_s$lat,data_s$lon)
426
    sta_delta_s=lookup(daily_delta_rast,data_s$lat,data_s$lon) #delta surface has been calculated before!!
427
    sta_bias_s= mod$fit
428
    #Need to extract values from the kriged delta surface...
429
    #sta_delta= lookup(delta_surface,data_v$lat,data_v$lon)
430
    #tmax_predicted=sta_LST+sta_bias-y_mod$fit
431
    tmax_predicted_s= sta_LST_s-sta_bias_s+sta_delta_s
432
    
433
    results_RMSE_f[i,1]<- dates[i]  #storing the interpolation dates in the first column
434
    results_RMSE_f[i,2]<- ns        #number of stations used in the training stage
435
    results_RMSE_f[i,3]<- "RSME"
436
    results_RMSE_f[i,j+3]<- sqrt(sum((tmax_predicted_s-data_s$dailyTmax)^2)/ns)
437
    
438
    ##Model assessment: general diagnostic/metrics
439
    ##validation: using the testing data
440
    
441
    #This was modified on 06192012
442
    
443
    #data_v$y_var<-data_v$LSTD_bias
444
    #data_v$y_var<-tmax
445
    y_mod<- predict(mod, newdata=data_v, se.fit = TRUE) #Using the coeff to predict new values.
446
    
447
    ####ADDED ON JULY 5th
448
    sta_LST_v=lookup(themolst,data_v$lat,data_v$lon)
449
    sta_delta_v=lookup(daily_delta_rast,data_v$lat,data_v$lon) #delta surface has been calculated before!!
450
    sta_bias_v= y_mod$fit
451
    #Need to extract values from the kriged delta surface...
452
    #sta_delta= lookup(delta_surface,data_v$lat,data_v$lon)
453
    #tmax_predicted=sta_LST+sta_bias-y_mod$fit
454
    tmax_predicted_v= sta_LST_v-sta_bias_v+sta_delta_v
455
    
456
    #data_v$tmax<-(data_v$tmax)/10
457
    res_mod<- data_v$dailyTmax - tmax_predicted_v              #Residuals for the model for fusion
458
    #res_mod<- data_v$y_var - y_mod$fit                  #Residuals for the model
459
    
460
    RMSE_mod <- sqrt(sum(res_mod^2)/nv)                 #RMSE FOR REGRESSION STEP 1: GAM     
461
    MAE_mod<- sum(abs(res_mod))/nv                     #MAE, Mean abs. Error FOR REGRESSION STEP 1: GAM   
462
    ME_mod<- sum(res_mod)/nv                            #ME, Mean Error or bias FOR REGRESSION STEP 1: GAM
463
    R2_mod<- cor(data_v$dailyTmax,tmax_predicted_v)^2              #R2, coef. of var FOR REGRESSION STEP 1: GAM
464
    
465
    results_RMSE[i,1]<- dates[i]    #storing the interpolation dates in the first column
466
    results_RMSE[i,2]<- ns          #number of stations used in the training stage
467
    results_RMSE[i,3]<- "RMSE"
468
    results_RMSE[i,j+3]<- RMSE_mod  #Storing RMSE for the model j
469
    results_MAE[i,1]<- dates[i]     #storing the interpolation dates in the first column
470
    results_MAE[i,2]<- ns           #number of stations used in the training stage
471
    results_MAE[i,3]<- "MAE"
472
    results_MAE[i,j+3]<- MAE_mod    #Storing MAE for the model j
473
    results_ME[i,1]<- dates[i]      #storing the interpolation dates in the first column
474
    results_ME[i,2]<- ns            #number of stations used in the training stage
475
    results_ME[i,3]<- "ME"
476
    results_ME[i,j+3]<- ME_mod      #Storing ME for the model j
477
    results_R2[i,1]<- dates[i]      #storing the interpolation dates in the first column
478
    results_R2[i,2]<- ns            #number of stations used in the training stage
479
    results_R2[i,3]<- "R2"
480
    results_R2[i,j+3]<- R2_mod      #Storing R2 for the model j
481
    
482
    #Saving residuals and prediction in the dataframes: tmax predicted from GAM
483
    pred<-paste("pred_mod",j,sep="")
484
    #data_v[[pred]]<-as.numeric(y_mod$fit)
485
    data_v[[pred]]<-as.numeric(tmax_predicted_v)
486
    data_s[[pred]]<-as.numeric(tmax_predicted_s) #Storing model fit values (predicted on training sample)
487
    #data_s[[pred]]<-as.numeric(mod$fit) #Storing model fit values (predicted on training sample)
488
    
489
    name2<-paste("res_mod",j,sep="")
490
    data_v[[name2]]<-as.numeric(res_mod)
491
    temp<-tmax_predicted_s-data_s$dailyTmax
492
    data_s[[name2]]<-as.numeric(temp)
493
    #end of loop calculating RMSE
494
    
495
  }
496

    
497
  # end of the for loop1
498
  
499
}
500

    
501

    
502
## Plotting and saving diagnostic measures
503

    
504
#Specific diagnostic measures related to the testing datasets
505

    
506
results_table_RMSE<-as.data.frame(results_RMSE)
507
results_table_MAE<-as.data.frame(results_MAE)
508
results_table_ME<-as.data.frame(results_ME)
509
results_table_R2<-as.data.frame(results_R2)
510

    
511
results_table_RMSE_f<-as.data.frame(results_RMSE_f)
512

    
513
cname<-c("dates","ns","metric","mod1", "mod2","mod3", "mod4", "mod5", "mod6", "mod7","mod8","mod9")
514
colnames(results_table_RMSE)<-cname
515
colnames(results_table_RMSE_f)<-cname
516

    
517
#tb_diagnostic1<-rbind(results_table_RMSE,results_table_MAE, results_table_ME, results_table_R2)   #
518
tb_diagnostic1<-results_table_RMSE      #measures of validation
519
tb_diagnostic2<-results_table_RMSE_f    #measures of fit
520

    
521
write.table(tb_diagnostic1, file= paste(path,"/","results_fusion_Assessment_measure1",out_prefix,".txt",sep=""), sep=",")
522
write.table(tb_diagnostic2, file= paste(path,"/","results_fusion_Assessment_measure2",out_prefix,".txt",sep=""), sep=",")
523

    
524
#### END OF SCRIPT
(20-20/32)