Project

General

Profile

« Previous | Next » 

Revision 51833ab5

Added by Benoit Parmentier over 11 years ago

GAM fusion Venezuela, output analyses to create quickly maps and plots for each date

View differences:

climate/research/oregon/interpolation/results_interpolation_date_output_analyses.R
1
##################    Validation and analyses of results  #######################################
2
############################ Covariate production for a given tile/region ##########################################
3
#This script examines inputs and outputs from the interpolation step.                             
4
#Part 1: Script produces plots for every selected date
5
#Part 2: Examine 
6
#AUTHOR: Benoit Parmentier                                                                       
7
#DATE: 02/22/2013                                                                                 
8

  
9
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#???--   
10

  
11
##Comments and TODO:
12
#Separate inteprolation results analyses from covariates analyses 
13

  
14
##################################################################################################
15

  
16
###Loading R library and packages   
17
library(RPostgreSQL)
18
library(sp)                                             # Spatial pacakge with class definition by Bivand et al.
19
library(spdep)                                          # Spatial pacakge with methods and spatial stat. by Bivand et al.
20
library(rgdal)                                          # GDAL wrapper for R, spatial utilities
21
library(raster)
22
library(gtools)
23
library(rasterVis)
24
library(graphics)
25
library(grid)
26
library(lattice)
27

  
28
### Parameters and arguments
29

  
30
##Paths to inputs and output
31
in_path <- "/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/input_data/"
32
out_path<- "/home/parmentier/Data/IPLANT_project/Venezuela_interpolation/Venezuela_01142013/output_data/"
33
infile3<-"covariates__venezuela_region__VE_01292013.tif" #this is an output from covariate script
34

  
35
setwd(in_path)
36

  
37
### Functions used in the script
38

  
39
load_obj <- function(f) 
40
{
41
  env <- new.env()
42
  nm <- load(f, env)[1]	
43
  env[[nm]]
44
}
45

  
46
### PLOTTING RESULTS FROM VENEZUELA INTERPOLATION FOR ANALYSIS
47

  
48
#Select relevant dates and load R objects created during the interpolation step
49

  
50
date_selected<-c("20100103")
51

  
52
gam_fus_mod<-load_obj("gam_fus_mod_365d_GAM_fus5_all_lstd_02202013.RData")
53
validation_obj<-load_obj("gam_fus_validation_mod_365d_GAM_fus5_all_lstd_02202013.RData")
54
clim_obj<-load_obj("gamclim_fus_mod_365d_GAM_fus5_all_lstd_02202013.RData")
55

  
56
#determine index position matching date selected
57

  
58
i_dates<-vector("list",length(date_selected))
59
for (i in 1:length(gam_fus_mod)){
60
  for (j in 1:length(date_selected)){
61
    if(gam_fus_mod[[i]]$sampling_dat$date==date_selected[j]){  
62
      i_dates[[j]]<-i
63
    }
64
  }
65
}
66

  
67
#Examine the first select date add loop or function later
68
j=1
69

  
70
date<-strptime(date_selected[j], "%Y%m%d")   # interpolation date being processed
71
month<-strftime(date, "%m")          # current month of the date being processed
72

  
73
#Get raster stack of interpolated surfaces
74
index<-i_dates[[j]]
75
pred_temp<-as.character(gam_fus_mod[[index]]$dailyTmax) #list of files
76
rast_pred_temp<-stack(pred_temp) #stack of temperature predictions from models 
77

  
78
#Get validation metrics, daily spdf training and testing stations, monthly spdf station input
79
sampling_dat<-gam_fus_mod[[index]]$sampling_dat
80
metrics_v<-validation_obj[[index]]$metrics_v
81
metrics_s<-validation_obj[[index]]$metrics_s
82
data_v<-validation_obj[[index]]$data_v
83
data_s<-validation_obj[[index]]$data_s
84
data_month<-clim_obj[[index]]$data_month
85

  
86
#Adding layer LST to the raster stack of covariates
87
#The names of covariates can be changed...
88
rnames <-c("x","y","lon","lat","N","E","N_w","E_w","elev","slope","aspect","CANHEIGHT","DISTOC")
89
lc_names<-c("LC1","LC2","LC3","LC4","LC5","LC6","LC7","LC8","LC9","LC10","LC11","LC12")
90
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",
91
             "nobs_01","nobs_02","nobs_03","nobs_04","nobs_05","nobs_06","nobs_07","nobs_08",
92
             "nobs_09","nobs_10","nobs_11","nobs_12")
93

  
94
covar_names<-c(rnames,lc_names,lst_names)
95

  
96
s_raster<-stack(infile3)                   #read in the data stack
97
names(s_raster)<-covar_names               #Assigning names to the raster layers: making sure it is included in the extraction
98

  
99
LST_month<-paste("mm_",month,sep="") # name of LST month to be matched
100
pos<-match("LST",layerNames(s_raster)) #Find the position of the layer with name "LST", if not present pos=NA
101
s_raster<-dropLayer(s_raster,pos)      # If it exists drop layer
102
pos<-match(LST_month,layerNames(s_raster)) #Find column with the current month for instance mm12
103
r1<-raster(s_raster,layer=pos)             #Select layer from stack
104
layerNames(r1)<-"LST"
105
#Get mask image!!
106

  
107
date_proc<-strptime(sampling_dat$date, "%Y%m%d")   # interpolation date being processed
108
mo<-as.integer(strftime(date_proc, "%m"))          # current month of the date being processed
109
day<-as.integer(strftime(date_proc, "%d"))
110
year<-as.integer(strftime(date_proc, "%Y"))
111
datelabel=format(ISOdate(year,mo,day),"%b %d, %Y")
112

  
113
## Figure 1: LST_TMax_scatterplot 
114

  
115
rmse<-metrics_v$rmse[nrow(metrics_v)]
116
rmse_f<-metrics_s$rmse[nrow(metrics_s)]  
117

  
118
png(paste("LST_TMax_scatterplot_",sampling_dat$date,"_",sampling_dat$prop,"_",sampling_dat$run_samp,
119
          out_prefix,".png", sep=""))
120
plot(data_month$TMax,data_month$LST,xlab="Station mo Tmax",ylab="LST mo Tmax")
121
title(paste("LST vs TMax for",datelabel,sep=" "))
122
abline(0,1)
123
nb_point<-paste("n=",length(data_month$TMax),sep="")
124
mean_bias<-paste("Mean LST bias= ",format(mean(data_month$LSTD_bias,na.rm=TRUE),digits=3),sep="")
125
#Add the number of data points on the plot
126
legend("topleft",legend=c(mean_bias,nb_point),bty="n")
127
dev.off()
128

  
129
## Figure 2: Daily_tmax_monthly_TMax_scatterplot 
130

  
131
png(paste("Daily_tmax_monthly_TMax_scatterplot_",sampling_dat$date,"_",sampling_dat$prop,"_",sampling_dat$run_samp,
132
          out_prefix,".png", sep=""))
133
plot(dailyTmax~TMax,data=data_s,xlab="Mo Tmax",ylab=paste("Daily for",datelabel),main="across stations in VE")
134
nb_point<-paste("ns=",length(data_s$TMax),sep="")
135
nb_point2<-paste("ns_obs=",length(data_s$TMax)-sum(is.na(data_s[[y_var_name]])),sep="")
136
nb_point3<-paste("n_month=",length(data_month$TMax),sep="")
137
#Add the number of data points on the plot
138
legend("topleft",legend=c(nb_point,nb_point2,nb_point3),bty="n",cex=0.8)
139
dev.off()
140

  
141
## Figure 3: Predicted_tmax_versus_observed_scatterplot 
142

  
143
#This is for mod_kr!! add other models later...
144
png(paste("Predicted_tmax_versus_observed_scatterplot_",sampling_dat$date,"_",sampling_dat$prop,"_",sampling_dat$run_samp,
145
          out_prefix,".png", sep=""))
146
plot(data_s$mod_kr~data_s[[y_var_name]],xlab=paste("Actual daily for",datelabel),ylab="Pred daily")
147
#plot(data_v$mod_kr~data_v[[y_var_name]],xlab=paste("Actual daily for",datelabel),ylab="Pred daily")
148
abline(0,1)
149
title(paste("Predicted_tmax_versus_observed_scatterplot for",datelabel,sep=" "))
150
nb_point1<-paste("ns_obs=",length(data_s$TMax)-sum(is.na(data_s[[y_var_name]])),sep="")
151
rmse_str1<-paste("RMSE= ",format(rmse,digits=3),sep="")
152
rmse_str2<-paste("RMSE_f= ",format(rmse_f,digits=3),sep="")
153

  
154
#Add the number of data points on the plot
155
legend("topleft",legend=c(nb_point1,rmse_str1,rmse_str2),bty="n",cex=0.8)
156
dev.off()
157

  
158
## Figure 4: delta surface and bias
159

  
160
#Plot bias,delta and prediction?
161

  
162
#To do
163
#Delta surface
164
#png(paste("Delta_surface_LST_TMax_",sampling_dat$date[i],"_",sampling_dat$prop[i],
165
#          "_",sampling_dat$run_samp[i],out_prefix,".png", sep=""))
166
#surface(fitdelta,col=rev(terrain.colors(100)),asp=1,main=paste("Interpolated delta for",datelabel,sep=" "))
167
#dev.off()
168
#
169
#bias_d_rast<-raster("fusion_bias_LST_20100103_30_1_10d_GAM_fus5_all_lstd_02082013.rst")
170
#plot(bias_d_rast)
171

  
172
## Figure 5: prediction raster images
173
png(paste("Raster_prediction_",sampling_dat$date,"_",sampling_dat$prop,"_",sampling_dat$run_samp,
174
          out_prefix,".png", sep=""))
175
#paste(metrics_v$pred_mod,format(metrics_v$rmse,digits=3),sep=":")
176
names(rast_pred_temp)<-paste(metrics_v$pred_mod,format(metrics_v$rmse,digits=3),sep=":")
177
plot(rast_pred_temp)
178
dev.off()
179

  
180
## Figure 6: training and testing stations used
181

  
182
plot(raster(rast_pred_temp,layer=5))
183
plot(data_s,col="black",cex=1.2,pch=4,add=TRUE)
184
plot(data_v,col="red",cex=1.2,pch=2,add=TRUE)
185

  
186
## Figure 7: monthly stations used 
187

  
188
plot(raster(rast_pred_temp,layer=5))
189
plot(data_month,col="black",cex=1.2,pch=4,add=TRUE)
190
title("Monthly ghcn station in Venezuela for January")
191

  
192
## Summarize information for the day: 
193

  
194
# ################
195
# #PART 2: Region Covariate analyses ###
196
# ################
197
# 
198
# # This should be in a separate script to analyze covariates from region.
199
# 
200
# #MAP1:Study area with LC mask and tiles/polygon outline
201
# 
202
# 
203
# #MAP 2: plotting land cover in the study region:
204
# 
205
# l1<-"LC1,Evergreen/deciduous needleleaf trees"
206
# l2<-"LC2,Evergreen broadleaf trees"
207
# l3<-"LC3,Deciduous broadleaf trees"
208
# l4<-"LC4,Mixed/other trees"
209
# l5<-"LC5,Shrubs"
210
# l6<-"LC6,Herbaceous vegetation"
211
# l7<-"LC7,Cultivated and managed vegetation"
212
# l8<-"LC8,Regularly flooded shrub/herbaceous vegetation"
213
# l9<-"LC9,Urban/built-up"
214
# l10<-"LC10,Snow/ice"
215
# l11<-"LC11,Barren lands/sparse vegetation"
216
# l12<-"LC12,Open water"
217
# lc_names_str<-c(l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12)
218
# 
219
# names(lc_reg_s)<-lc_names_str
220
# 
221
# png(paste("LST_TMax_scatterplot_",sampling_dat$date[i],"_",sampling_dat$prop[i],"_",sampling_dat$run_samp[i], out_prefix,".png", sep=""))
222
# plot(modst$TMax,sta_tmax_from_lst,xlab="Station mo Tmax",ylab="LST mo Tmax",main=paste("LST vs TMax for",datelabel,sep=" "))
223
# abline(0,1)
224
# nb_point<-paste("n=",length(modst$TMax),sep="")
225
# mean_bias<-paste("LST bigrasas= ",format(mean(modst$LSTD_bias,na.rm=TRUE),digits=3),sep="")
226
# #Add the number of data points on the plot
227
# legend("topleft",legend=c(mean_bias,nb_point),bty="n")
228
# dev.off()
229
# 
230
# #Map 3: Elevation and LST in January
231
# tmp_s<-stack(LST,elev_1)
232
# png(paste("LST_elev_",sampling_dat$date[i],"_",sampling_dat$prop[i],"_",sampling_dat$run_samp[i], out_prefix,".png", sep=""))
233
# plot(tmp_s)
234
# 
235
# #Map 4: LST climatology per month
236
#         
237
# names_tmp<-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")
238
# LST_s<-subset(s_raster,names_tmp)
239
# names_tmp<-c("nobs_01","nobs_02","nobs_03","nobs_04","nobs_05","nobs_06","nobs_07","nobs_08",
240
#              "nobs_09","nobs_10","nobs_11","nobs_12")
241
# LST_nobs<-subset(s_raster,names_tmp)
242
# 
243
# LST_nobs<-mask(LST_nobs,LC_mask,filename="test2.tif")
244
# LST_s<-mask(LST_s,LC_mask,filename="test3.tif")
245
# c("Jan","Feb")
246
# plot(LST_s)
247
# plot(LST_nobs)
248
# 
249
# #Map 5: LST and TMax
250
# 
251
# #note differnces in patternin agricultural areas and 
252
# min_values<-cellStats(LST_s,"min")
253
# max_values<-cellStats(LST_s,"max")
254
# mean_values<-cellStats(LST_s,"mean")
255
# sd_values<-cellStats(LST_s,"sd")
256
# #median_values<-cellStats(molst,"median") Does not extist
257
# statistics_LST_s<-cbind(min_values,max_values,mean_values,sd_values) #This shows that some values are extremes...especially in October
258
# LST_stat_data<-as.data.frame(statistics_LST_s)
259
# names(LST_stat_data)<-c("min","max","mean","sd")
260
# # Statistics for number of valid observation stack
261
# min_values<-cellStats(nobslst,"min")
262
# max_values<-cellStats(nobslst,"max")
263
# mean_values<-cellStats(nobslst,"mean")
264
# sd_values<-cellStats(nobslst,"sd")
265
# statistics_LSTnobs_s<-cbind(min_values,max_values,mean_values,sd_values) #This shows that some values are extremes...especially in October
266
# LSTnobs_stat_data<-as.data.frame(statistics_LSTnobs_s)
267
# 
268
# X11(width=12,height=12)
269
# #Plot statiscs (mean,min,max) for monthly LST images
270
# plot(1:12,LST_stat_data$mean,type="b",ylim=c(-15,60),col="black",xlab="month",ylab="tmax (degree C)")
271
# lines(1:12,LST_stat_data$min,type="b",col="blue")
272
# lines(1:12,LST_stat_data$max,type="b",col="red")
273
# text(1:12,LST_stat_data$mean,rownames(LST_stat_data),cex=1,pos=2)
274
# 
275
# legend("topleft",legend=c("min","mean","max"), cex=1.5, col=c("blue","black","red"),
276
#        lty=1)
277
# title(paste("LST statistics for Oregon", "2010",sep=" "))
278
# savePlot("lst_statistics_OR.png",type="png")
279
# 
280
# #Plot number of valid observations for LST
281
# plot(1:12,LSTnobs_stat_data$mean,type="b",ylim=c(0,280),col="black",xlab="month",ylab="tmax (degree C)")
282
# lines(1:12,LSTnobs_stat_data$min,type="b",col="blue")
283
# lines(1:12,LSTnobs_stat_data$max,type="b",col="red")
284
# text(1:12,LSTnobs_stat_data$mean,rownames(LSTnobs_stat_data),cex=1,pos=2)
285
# 
286
# legend("topleft",legend=c("min","mean","max"), cex=1.5, col=c("blue","black","red"),
287
#        lty=1)
288
# title(paste("LST number of valid observations for Oregon", "2010",sep=" "))
289
# savePlot("lst_nobs_OR.png",type="png")
290
# 
291
# plot(data_month$TMax,add=TRUE)
292
# 
293
# ### Map 6: station in the region
294
# 
295
# plot(tmax_predicted)
296
# plot(data_s,col="black",cex=1.2,pch=4,add=TRUE)
297
# plot(data_v,col="blue",cex=1.2,pch=2,add=TRUE)
298
# 
299
# plot(tmax_predicted)
300
# plot(data_month,col="black",cex=1.2,pch=4,add=TRUE)
301
# title("Monthly ghcn station in Venezuela for 2000-2010")
302
# 
303

  
304
#### End of script ####

Also available in: Unified diff