Revision 30f84063
Added by Benoit Parmentier about 12 years ago
climate/research/oregon/interpolation/methods_comparison_assessment_part5.R | ||
---|---|---|
1 |
##################################### METHODS COMPARISON part 5 ########################################## |
|
2 |
#################################### Spatial Analysis ############################################ |
|
3 |
#This script utilizes the R ojbects created during the interpolation phase. # |
|
4 |
#At this stage the script produces figures of various accuracy metrics and compare methods: # |
|
5 |
#This scripts focuses on a detailed studay of differences in the predictions of CAI_kr and FUsion_Kr # |
|
6 |
#AUTHOR: Benoit Parmentier # |
|
7 |
#DATE: 11/23/2012 # |
|
8 |
#PROJECT: NCEAS INPLANT: Environment and Organisms --TASK#491 -- # |
|
9 |
################################################################################################### |
|
10 |
|
|
11 |
###Loading R library and packages |
|
12 |
library(gtools) # loading some useful tools such as mixedsort |
|
13 |
library(mgcv) # GAM package by Wood 2006 (version 2012) |
|
14 |
library(sp) # Spatial pacakge with class definition by Bivand et al. 2008 |
|
15 |
library(spdep) # Spatial package with methods and spatial stat. by Bivand et al. 2012 |
|
16 |
library(rgdal) # GDAL wrapper for R, spatial utilities (Keitt et al. 2012) |
|
17 |
library(gstat) # Kriging and co-kriging by Pebesma et al. 2004 |
|
18 |
library(automap) # Automated Kriging based on gstat module by Hiemstra et al. 2008 |
|
19 |
library(spgwr) |
|
20 |
library(gpclib) |
|
21 |
library(maptools) |
|
22 |
library(graphics) |
|
23 |
library(parallel) # Urbanek S. and Ripley B., package for multi cores & parralel processing |
|
24 |
library(raster) |
|
25 |
library(rasterVis) |
|
26 |
library(plotrix) #Draw circle on graph |
|
27 |
library(reshape) |
|
28 |
######### Functions used in the script |
|
29 |
#loading R objects that might have similar names |
|
30 |
load_obj <- function(f) |
|
31 |
{ |
|
32 |
env <- new.env() |
|
33 |
nm <- load(f, env)[1] |
|
34 |
env[[nm]] |
|
35 |
} |
|
36 |
|
|
37 |
plot_transect<-function(list_trans,r_stack,title_plot,disp=TRUE){ |
|
38 |
#This function creates plot of transects for stack of raster images. |
|
39 |
#The parameters are: |
|
40 |
#list_trans: list of files containing the transects lines in shapefile format |
|
41 |
#r_stack: raster stack of files |
|
42 |
#title_plot: plot title |
|
43 |
#disp: dispaly and save from X11 if TRUE |
|
44 |
nb<-length(list_trans) |
|
45 |
t_col<-rainbow(nb) |
|
46 |
list_trans_data<-vector("list",nb) |
|
47 |
for (i in 1:nb){ |
|
48 |
trans_file<-list_trans[[i]][1] |
|
49 |
filename<-sub(".shp","",trans_file) #Removing the extension from file. |
|
50 |
transect<-readOGR(".", filename) #reading shapefile |
|
51 |
trans_data<-extract(r_stack, transect) |
|
52 |
if (disp==FALSE){ |
|
53 |
png(file=paste(list_trans[[i]]),".png",sep="") |
|
54 |
} |
|
55 |
for (k in 1:ncol(trans_data[[1]])){ |
|
56 |
y<-trans_data[[1]][,k] |
|
57 |
x<-1:length(y) |
|
58 |
if (k!=1){ |
|
59 |
lines(x,y,col=t_col[k]) |
|
60 |
} |
|
61 |
if (k==1){ |
|
62 |
plot(x,y,type="l",xlab="Position index", ylab="temperature",col=rainbow(k)) |
|
63 |
} |
|
64 |
} |
|
65 |
title(title_plot[i]) |
|
66 |
legend("topright",legend=layerNames(r_stack), |
|
67 |
cex=1.2, col=t_col, |
|
68 |
lty=1) |
|
69 |
|
|
70 |
if (disp==TRUE){ |
|
71 |
savePlot(file=paste(list_trans[[i]][2],".png",sep=""),type="png") |
|
72 |
} |
|
73 |
if (disp==FALSE){ |
|
74 |
dev.off() |
|
75 |
} |
|
76 |
list_trans_data[[i]]<-trans_data |
|
77 |
} |
|
78 |
names(list_trans_data)<-names(list_trans) |
|
79 |
return(list_trans_data) |
|
80 |
} |
|
81 |
|
|
82 |
plot_transect_m<-function(list_trans,r_stack,title_plot,disp=TRUE,m_layers){ |
|
83 |
#This function creates plot of transects for stack of raster images. |
|
84 |
#Arguments: |
|
85 |
#list_trans: list of files containing the transects lines in shapefile format |
|
86 |
#r_stack: raster stack containing the information to extect |
|
87 |
#title_plot: plot title |
|
88 |
#disp: display and save from X11 if TRUE or plot to png file if FALSE |
|
89 |
#m_layers: index for layerers containing alternate units to be drawned on a differnt scale |
|
90 |
#RETURN: |
|
91 |
#list containing transect information |
|
92 |
|
|
93 |
nb<-length(list_trans) |
|
94 |
t_col<-rainbow(nb) |
|
95 |
list_trans_data<-vector("list",nb) |
|
96 |
|
|
97 |
#For scale 1 |
|
98 |
for (i in 1:nb){ |
|
99 |
trans_file<-list_trans[[i]][1] |
|
100 |
filename<-sub(".shp","",trans_file) #Removing the extension from file. |
|
101 |
transect<-readOGR(".", filename) #reading shapefile |
|
102 |
trans_data<-extract(r_stack, transect) |
|
103 |
if (disp==FALSE){ |
|
104 |
png(file=paste(list_trans[[i]]),".png",sep="") |
|
105 |
} |
|
106 |
#Plot layer values for specific transect |
|
107 |
for (k in 1:ncol(trans_data[[1]])){ |
|
108 |
y<-trans_data[[1]][,k] |
|
109 |
x<-1:length(y) |
|
110 |
m<-match(k,m_layers) |
|
111 |
|
|
112 |
if (k==1 & is.na(m)){ |
|
113 |
plot(x,y,type="l",xlab="Position index", ylab="temperature",col=t_col[k]) |
|
114 |
axis(2,xlab="",ylab="tmax (in degree C)") |
|
115 |
} |
|
116 |
if (k==1 & !is.na(m)){ |
|
117 |
plot(x,y,type="l",col=t_col[k],axes=F) #plotting fusion profile |
|
118 |
axis(4,xlab="",ylab="tmax (in degree C)") |
|
119 |
|
|
120 |
} |
|
121 |
if (k!=1 & is.na(m)){ |
|
122 |
#par(new=TRUE) # new plot without erasing old |
|
123 |
lines(x,y,type="l",col=t_col[k],axes=F) #plotting fusion profile |
|
124 |
#axis(2,xlab="",ylab="tmax (in degree C)") |
|
125 |
} |
|
126 |
if (k!=1 & !is.na(m)){ |
|
127 |
par(new=TRUE) # key: ask for new plot without erasing old |
|
128 |
plot(x,y,type="l",col=t_col[k],axes=F) #plotting fusion profile |
|
129 |
#axis(4,xlab="",ylab="tmax (in degree C)") |
|
130 |
} |
|
131 |
|
|
132 |
} |
|
133 |
title(title_plot[i]) |
|
134 |
legend("topright",legend=layerNames(r_stack), |
|
135 |
cex=1.2, col=t_col, |
|
136 |
lty=1) |
|
137 |
|
|
138 |
if (disp==TRUE){ |
|
139 |
savePlot(file=paste(list_trans[[i]][2],".png",sep=""),type="png") |
|
140 |
} |
|
141 |
if (disp==FALSE){ |
|
142 |
dev.off() |
|
143 |
} |
|
144 |
list_trans_data[[i]]<-trans_data |
|
145 |
} |
|
146 |
names(list_trans_data)<-names(list_trans) |
|
147 |
return(list_trans_data) |
|
148 |
} |
|
149 |
|
|
150 |
transect_from_spdf<-function (spdf,selected_features){ |
|
151 |
#This function produces a transect from a set of selected points in a point layer |
|
152 |
# Arguments: |
|
153 |
# spdf: SpatialPointDataFrame |
|
154 |
# selected_features: index of ssubset points used in the transect line |
|
155 |
# Return: SpatialLinesDataframe object corresponding to the transect |
|
156 |
# Author: Benoit Parmentier |
|
157 |
# Date: 11-29-2012 |
|
158 |
|
|
159 |
dat_id<-spdf[selected_features,] #creating new subset from spdf |
|
160 |
spdf_proj<-proj4string(dat_id) |
|
161 |
matrix_point_coords<-coordinates(dat_id) |
|
162 |
#Add possibility of keeping attributes? |
|
163 |
#Transform a sequence of points with coords into Spatial Lines |
|
164 |
#Note that X is the ID, modify for dataframe? |
|
165 |
trans4<-SpatialLines(list(Lines(list(Line(coordinates(matrix_point_coords))),"X"))) |
|
166 |
tmp<-as.data.frame(dat_id[1,]) |
|
167 |
row.names(tmp)<-rep("X",1) |
|
168 |
trans4<-SpatialLinesDataFrame(trans4,data=tmp) |
|
169 |
proj4string(trans4)<-spdf_proj |
|
170 |
return(trans4) |
|
171 |
} |
|
172 |
|
|
173 |
###Parameters and arguments |
|
174 |
|
|
175 |
infile1<- "ghcn_or_tmax_covariates_06262012_OR83M.shp" #GHCN shapefile containing variables for modeling 2010 |
|
176 |
#infile2<-"list_10_dates_04212012.txt" #List of 10 dates for the regression |
|
177 |
infile2<-"list_365_dates_04212012.txt" #list of dates |
|
178 |
infile3<-"LST_dates_var_names.txt" #LST dates name |
|
179 |
infile4<-"models_interpolation_05142012.txt" #Interpolation model names |
|
180 |
infile5<-"mean_day244_rescaled.rst" #mean LST for day 244 |
|
181 |
inlistf<-"list_files_05032012.txt" #list of raster images containing the Covariates |
|
182 |
infile6<-"OR83M_state_outline.shp" |
|
183 |
#stat_loc<-read.table(paste(path,"/","location_study_area_OR_0602012.txt",sep=""),sep=",", header=TRUE) |
|
184 |
|
|
185 |
out_prefix<-"methods_11292012_" |
|
186 |
nb_transect<-4 |
|
187 |
##### LOAD USEFUL DATA |
|
188 |
|
|
189 |
#obj_list<-"list_obj_08262012.txt" #Results of fusion from the run on ATLAS |
|
190 |
path<-"/home/parmentier/Data/IPLANT_project/methods_interpolation_comparison_10242012" #Jupiter LOCATION on Atlas for kriging #Jupiter Location on XANDERS |
|
191 |
#path<-"/Users/benoitparmentier/Dropbox/Data/NCEAS/Oregon_covariates/" #Local dropbox folder on Benoit's laptop |
|
192 |
setwd(path) |
|
193 |
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"; |
|
194 |
#User defined output prefix |
|
195 |
|
|
196 |
#CRS<-proj4string(ghcn) #Storing projection information (ellipsoid, datum,etc.) |
|
197 |
lines<-read.table(paste(path,"/",inlistf,sep=""), sep="") #Column 1 contains the names of raster files |
|
198 |
inlistvar<-lines[,1] |
|
199 |
inlistvar<-paste(path,"/",as.character(inlistvar),sep="") |
|
200 |
covar_names<-as.character(lines[,2]) #Column two contains short names for covaraites |
|
201 |
|
|
202 |
s_raster<- stack(inlistvar) #Creating a stack of raster images from the list of variables. |
|
203 |
layerNames(s_raster)<-covar_names #Assigning names to the raster layers |
|
204 |
projection(s_raster)<-proj_str |
|
205 |
|
|
206 |
#Create mask using land cover data |
|
207 |
pos<-match("LC10",layerNames(s_raster)) #Find the layer which contains water bodies |
|
208 |
LC10<-subset(s_raster,pos) |
|
209 |
LC10[is.na(LC10)]<-0 #Since NA values are 0, we assign all zero to NA |
|
210 |
mask_land<-LC10<100 #All values below 100% water are assigned the value 1, value 0 is "water" |
|
211 |
mask_land_NA<-mask_land |
|
212 |
mask_land_NA[mask_land_NA==0]<-NA #Water bodies are assigned value 1 |
|
213 |
|
|
214 |
data_name<-"mask_land_OR" |
|
215 |
raster_name<-paste(data_name,".rst", sep="") |
|
216 |
writeRaster(mask_land, filename=raster_name,overwrite=TRUE) #Writing the data in a raster file format...(IDRISI) |
|
217 |
#writeRaster(r2, filename=raster_name,overwrite=TRUE) #Writing the data in a raster file format...(IDRISI) |
|
218 |
|
|
219 |
pos<-match("ELEV_SRTM",layerNames(s_raster)) #Find column with name "ELEV_SRTM" |
|
220 |
ELEV_SRTM<-raster(s_raster,layer=pos) #Select layer from stack on 10/30 |
|
221 |
s_raster<-dropLayer(s_raster,pos) |
|
222 |
ELEV_SRTM[ELEV_SRTM <0]<-NA |
|
223 |
mask_ELEV_SRTM<-ELEV_SRTM>0 |
|
224 |
|
|
225 |
#Change this a in loop... |
|
226 |
pos<-match("LC1",layerNames(s_raster)) #Find column with name "value" |
|
227 |
LC1<-raster(s_raster,layer=pos) #Select layer from stack |
|
228 |
s_raster<-dropLayer(s_raster,pos) |
|
229 |
LC1[is.na(LC1)]<-0 |
|
230 |
pos<-match("LC2",layerNames(s_raster)) #Find column with name "value" |
|
231 |
LC2<-raster(s_raster,layer=pos) #Select layer from stack |
|
232 |
s_raster<-dropLayer(s_raster,pos) |
|
233 |
LC2[is.na(LC2)]<-0 |
|
234 |
pos<-match("LC3",layerNames(s_raster)) #Find column with name "value" |
|
235 |
LC3<-raster(s_raster,layer=pos) #Select layer from stack |
|
236 |
s_raster<-dropLayer(s_raster,pos) |
|
237 |
LC3[is.na(LC3)]<-0 |
|
238 |
pos<-match("LC4",layerNames(s_raster)) #Find column with name "value" |
|
239 |
LC4<-raster(s_raster,layer=pos) #Select layer from stack |
|
240 |
s_raster<-dropLayer(s_raster,pos) |
|
241 |
LC4[is.na(LC4)]<-0 |
|
242 |
pos<-match("LC6",layerNames(s_raster)) #Find column with name "value" |
|
243 |
LC6<-raster(s_raster,layer=pos) #Select layer from stack |
|
244 |
s_raster<-dropLayer(s_raster,pos) |
|
245 |
LC6[is.na(LC6)]<-0 |
|
246 |
pos<-match("LC7",layerNames(s_raster)) #Find column with name "value" |
|
247 |
LC7<-raster(s_raster,layer=pos) #Select layer from stack |
|
248 |
s_raster<-dropLayer(s_raster,pos) |
|
249 |
LC7[is.na(LC7)]<-0 |
|
250 |
pos<-match("LC9",layerNames(s_raster)) #Find column with name "LC9", this is wetland... |
|
251 |
LC9<-raster(s_raster,layer=pos) #Select layer from stack |
|
252 |
s_raster<-dropLayer(s_raster,pos) |
|
253 |
LC9[is.na(LC9)]<-0 |
|
254 |
|
|
255 |
LC_s<-stack(LC1,LC2,LC3,LC4,LC6,LC7) |
|
256 |
layerNames(LC_s)<-c("LC1_forest","LC2_shrub","LC3_grass","LC4_crop","LC6_urban","LC7_barren") |
|
257 |
LC_s <-mask(LC_s,mask_ELEV_SRTM) |
|
258 |
plot(LC_s) |
|
259 |
|
|
260 |
s_raster<-addLayer(s_raster, LC_s) |
|
261 |
|
|
262 |
#mention this is the last... files |
|
263 |
|
|
264 |
#Read region outline... |
|
265 |
filename<-sub(".shp","",infile6) #Removing the extension from file. |
|
266 |
reg_outline<-readOGR(".", filename) #reading shapefile |
|
267 |
|
|
268 |
############ PART 4: RESIDUALS ANALYSIS: ranking, plots, focus regions ################## |
|
269 |
############## EXAMINING STATION RESIDUALS ########### |
|
270 |
########### CONSTANT OVER 365 AND SAMPLING OVER 365 |
|
271 |
#Plot daily_deltaclim_rast, bias_rast,add data_s and data_v |
|
272 |
|
|
273 |
# RANK STATION by average or median RMSE |
|
274 |
# Count the number of times a station is in the extremum group of outliers... |
|
275 |
# LOOK at specific date... |
|
276 |
|
|
277 |
#Examine residuals for a spciefic date...Jan, 1 using run of const_all i.e. same training over 365 dates |
|
278 |
path_data_cai<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations_10242012_CAI" #Change to constant |
|
279 |
path_data_fus<-"/home/parmentier/Data/IPLANT_project/data_Oregon_stations_10242012_GAM" |
|
280 |
|
|
281 |
date_selected<-"20100103" |
|
282 |
|
|
283 |
oldpath<-getwd() |
|
284 |
setwd(path_data_cai) |
|
285 |
|
|
286 |
################ VISUALIZATION !!!!!!!! ############ |
|
287 |
#updated the analysis |
|
288 |
|
|
289 |
dates<-c("20100103","20100901") |
|
290 |
i=2 |
|
291 |
|
|
292 |
for(i in 1:length(dates)){ |
|
293 |
|
|
294 |
date_selected<-dates[i] |
|
295 |
oldpath<-getwd() |
|
296 |
setwd(path_data_cai) |
|
297 |
file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_CAI2_const_all_10312012.rst",sep="")) #Search for files in relation to fusion |
|
298 |
lf_cai2c<-list.files(pattern=file_pat) #Search for files in relation to fusion |
|
299 |
rast_cai2c<-stack(lf_cai2c) #lf_cai2c CAI results with constant sampling over 365 dates |
|
300 |
rast_cai2c<-mask(rast_cai2c,mask_ELEV_SRTM) |
|
301 |
|
|
302 |
oldpath<-getwd() |
|
303 |
setwd(path_data_fus) |
|
304 |
file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_fusion_const_all_lstd_11022012.rst",sep="")) #Search for files in relation to fusion |
|
305 |
lf_fus1c<-list.files(pattern=file_pat) #Search for files in relation to fusion |
|
306 |
rast_fus1c<-stack(lf_fus1c) |
|
307 |
rast_fus1c<-mask(rast_fus1c,mask_ELEV_SRTM) |
|
308 |
|
|
309 |
#PLOT ALL MODELS |
|
310 |
#Prepare for plotting |
|
311 |
|
|
312 |
setwd(path) #set path to the output path |
|
313 |
|
|
314 |
s_range<-c(minValue(rast_fus1c),maxValue(rast_fus1c)) #stack min and max |
|
315 |
s_range<-c(min(s_range),max(s_range)) |
|
316 |
col_breaks <- pretty(s_range, n=50) |
|
317 |
lab_breaks <- pretty(s_range, n=5) |
|
318 |
temp_colors <- colorRampPalette(c('blue', 'white', 'red')) |
|
319 |
X11(width=18,height=12) |
|
320 |
par(mfrow=c(3,3)) |
|
321 |
for (k in 1:length(lf_fus1c)){ |
|
322 |
fus1c_r<-raster(rast_fus1c,k) |
|
323 |
plot(fus1c_r, breaks=col_breaks, col=temp_colors(length(col_breaks)-1), |
|
324 |
axis=list(at=lab_breaks, labels=lab_breaks)) |
|
325 |
} |
|
326 |
plot(rast_fus1c,col=temp_colors(49)) |
|
327 |
savePlot(paste("fig1_diff_models_fusion_",date_selected,out_prefix,".png", sep=""), type="png") |
|
328 |
dev.off() |
|
329 |
s_range<-c(minValue(rast_cai2c),maxValue(rast_cai2c)) #stack min and max |
|
330 |
s_range<-c(min(s_range),max(s_range)) |
|
331 |
col_breaks <- pretty(s_range, n=50) |
|
332 |
lab_breaks <- pretty(s_range, n=5) |
|
333 |
temp_colors <- colorRampPalette(c('blue', 'white', 'red')) |
|
334 |
X11(width=18,height=12) |
|
335 |
par(mfrow=c(3,3)) |
|
336 |
for (k in 1:length(lf_fus1c)){ |
|
337 |
cai2c_r<-raster(rast_cai2c,k) |
|
338 |
plot(cai2c_r, breaks=col_breaks, col=temp_colors(length(col_breaks)-1), |
|
339 |
axis=list(at=lab_breaks, labels=lab_breaks)) |
|
340 |
} |
|
341 |
plot(rast_cai2c,col=temp_colors(49)) |
|
342 |
savePlot(paste("fig2_diff_models_cai_",date_selected,out_prefix,".png", sep=""), type="png") |
|
343 |
dev.off() |
|
344 |
#PLOT CAI_Kr and Fusion_Kr |
|
345 |
|
|
346 |
rast_fus_pred<-raster(rast_fus1c,1) # Select the first model from the stack i.e fusion with kriging for both steps |
|
347 |
rast_cai_pred<-raster(rast_cai2c,1) |
|
348 |
layerNames(rast_cai_pred)<-paste("cai",date_selected,sep="_") |
|
349 |
layerNames(rast_fus_pred)<-paste("fus",date_selected,sep="_") |
|
350 |
#Plot side by side |
|
351 |
X11(width=16,height=9) |
|
352 |
rast_pred<-stack(rast_cai_pred,rast_fus_pred) |
|
353 |
layerNames(rast_pred)<-c(paste('CAI_kr',date_selected,sep=" "),paste('Fusion_kr',date_selected,sep=" ")) |
|
354 |
s.range <- c(min(minValue(rast_pred)), max(maxValue(rast_pred))) |
|
355 |
col.breaks <- pretty(s.range, n=50) |
|
356 |
lab.breaks <- pretty(s.range, n=5) |
|
357 |
temp.colors <- colorRampPalette(c('blue', 'white', 'red')) |
|
358 |
plot(rast_pred, breaks=col.breaks, col=temp.colors(length(col.breaks)-1), |
|
359 |
axis=list(at=lab.breaks, labels=lab.breaks)) |
|
360 |
savePlot(paste("fig3_diff_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png") |
|
361 |
|
|
362 |
#Scatter plot of fus vs cai |
|
363 |
plot(values(rast_fus_pred),values(rast_cai_pred),ylab="CAI",xlab="Fusion",axis=FALSE) |
|
364 |
title(paste("CAI and fusion scatterplot on ",date_selected,sep="")) |
|
365 |
savePlot(paste("fig4_diff_image_scatterplot_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png") |
|
366 |
dev.off() |
|
367 |
|
|
368 |
## Start difference analysis |
|
369 |
#Calculate difference image for the date selected |
|
370 |
rast_diff<-rast_fus_pred-rast_cai_pred |
|
371 |
layerNames(rast_diff)<-paste("diff",date_selected,sep="_") |
|
372 |
mean_val<-cellStats(rast_diff,mean) |
|
373 |
sd_val<-cellStats(rast_diff,sd) |
|
374 |
|
|
375 |
#View classified diff and outliers... |
|
376 |
diff_n_outlier<-rast_diff< (2*-sd_val) #Create negative and positive outliers... |
|
377 |
diff_p_outlier<-rast_diff> (2*sd_val) #Create negative and positive outliers... |
|
378 |
diff_outlier<-stack(diff_n_outlier,diff_p_outlier) |
|
379 |
layerNames(diff_outlier)<-c("Negative_diff_outliers","Positive_diff_outliers") |
|
380 |
bool_ramp<-colorRampPalette(c("black","red")) |
|
381 |
X11() |
|
382 |
plot(diff_outlier,col=bool_ramp(2)) |
|
383 |
savePlot(paste("fig5_diff_image_outliers_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png") |
|
384 |
dev.off() |
|
385 |
tmp<-overlay(diff_n_outlier,ELEV_SRTM,fun=function(x,y){return(x*y)}) |
|
386 |
#could use mask |
|
387 |
tmp[tmp==0]<-NA |
|
388 |
mean_Elev_n_outliers<-cellStats(tmp,mean) |
|
389 |
mean_Elev<-cellStats(ELEV_SRTM,mean) |
|
390 |
print(c(mean_Elev_n_outliers,mean_Elev),digits=7) #This shows that outliers are in higher areas |
|
391 |
# on average: 1691m compared to 1044m |
|
392 |
##postive outliers and land cover |
|
393 |
#LC2 (shrub), LC1(forest),LC3(grass),LC4(crop) |
|
394 |
tmp<-overlay(diff_p_outlier,LC2,fun=function(x,y){return(x*y)}) |
|
395 |
tmp[tmp==0]<-NA |
|
396 |
mean_LC2_p_outliers<-cellStats(tmp,mean) #There is more shrub (44.84% than on average 22.32) |
|
397 |
mean_LC2<-cellStats(LC2,mean) |
|
398 |
print(c(mean_LC2_p_outliers,mean_LC2),digits=7) #This shows that outliers have in higher |
|
399 |
#proportion of shurb (44% against 25%) |
|
400 |
tmp<-overlay(diff_p_outlier,LC3,fun=function(x,y){return(x*y)}) |
|
401 |
tmp[tmp==0]<-NA |
|
402 |
mean_LC3_p_outliers<-cellStats(tmp,mean) #There is more grass (42.73% than on average 14.47) |
|
403 |
mean_LC3<-cellStats(LC3,mean) |
|
404 |
print(c(mean_LC3_p_outliers,mean_LC3),digits=7) #This shows that outliers have in higher |
|
405 |
#proportion of shurb (44% against 25%) |
|
406 |
tmp<-overlay(diff_p_outlier,LC4,fun=function(x,y){return(x*y)}) |
|
407 |
tmp[tmp==0]<-NA |
|
408 |
mean_LC4_p_outliers<-cellStats(tmp,mean) #There is more grass (42.73% than on average 14.47) |
|
409 |
mean_LC4<-cellStats(LC4,mean) |
|
410 |
print(c(mean_LC4_p_outliers,mean_LC4),digits=7) #This shows that outliers have in higher |
|
411 |
|
|
412 |
#CREATE A TABLE |
|
413 |
|
|
414 |
#### |
|
415 |
#View histogram |
|
416 |
hist(rast_diff) |
|
417 |
|
|
418 |
### More Land cover analysis related to references... |
|
419 |
|
|
420 |
LC2<-mask(LC2,mask_ELEV_SRTM) |
|
421 |
cellStats(LC2,"countNA") #Check that NA have been assigned to water and areas below 0 m |
|
422 |
|
|
423 |
LC2_50_m<- LC2>50 |
|
424 |
|
|
425 |
LC2_50<-LC2_50_m*LC2 |
|
426 |
diff_LC2_50<-LC2_50_m*rast_diff |
|
427 |
cellStats(diff_LC2_50,"mean") |
|
428 |
plot(LC2) |
|
429 |
plot(LC2_50) |
|
430 |
freq(LC2_50) |
|
431 |
|
|
432 |
#Forest NOW |
|
433 |
LC1<-mask(LC1,mask_ELEV_SRTM) |
|
434 |
cellStats(LC1,"countNA") #Check that NA have been assigned to water and areas below 0 m |
|
435 |
|
|
436 |
LC1_50_m<- LC1>50 |
|
437 |
LC1_100_m<- LC1>=100 |
|
438 |
LC1_50_m[LC1_50_m==0]<-NA |
|
439 |
LC1_100_m[LC1_100_m==0]<-NA |
|
440 |
LC1_50<-LC1_50_m*LC1 |
|
441 |
LC1_100<-LC1_100_m*LC1 |
|
442 |
plot(LC1) |
|
443 |
plot(LC1_50_m) |
|
444 |
freq(LC1_50_m) |
|
445 |
diff_LC1_50<-LC1_50_m*rast_diff |
|
446 |
diff_LC1_100<-LC1_100_m*rast_diff |
|
447 |
|
|
448 |
plot(diff_LC1_50) |
|
449 |
cellStats(diff_LC1_50,"mean") |
|
450 |
cellStats(diff_LC1_100,"mean") |
|
451 |
plot(values(diff_LC1_50),values(LC1_50)) |
|
452 |
plot(values(diff_LC1_100),values(LC1_100)) |
|
453 |
x<-brick(LC1,rast_diff) |
|
454 |
|
|
455 |
#Summarize results using plot |
|
456 |
#LC1 and LC3 and LC4 |
|
457 |
avl<-c(0,10,1,10,20,2,20,30,3,30,40,4,40,50,5,50,60,6,60,70,7,70,80,8,80,90,9,90,100,10)#Note that category 1 does not include 0!! |
|
458 |
rclmat<-matrix(avl,ncol=3,byrow=TRUE) |
|
459 |
LC1_rec<-reclass(LC1,rclmat) #Loss of layer names when using reclass |
|
460 |
LC2_rec<-reclass(LC2,rclmat) #Loss of layer names when using reclass |
|
461 |
LC3_rec<-reclass(LC3,rclmat) #Loss of layer names when using reclass |
|
462 |
LC4_rec<-reclass(LC4,rclmat) #Loss of layer names when using reclass |
|
463 |
LC6_rec<-reclass(LC6,rclmat) #Loss of layer names when using reclass |
|
464 |
|
|
465 |
#LC_s<-stack(LC1,LC3,LC4,LC6) |
|
466 |
LC_s<-stack(LC1,LC2,LC3,LC4,LC6) |
|
467 |
layerNames(LC_s)<-c("LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban") |
|
468 |
LC_s<-mask(LC_s,mask_ELEV_SRTM) |
|
469 |
LC_rec_s<-reclass(LC_s,rclmat) |
|
470 |
|
|
471 |
#plot average difference per class of forest and LC2 |
|
472 |
rast_stack_zones<-LC_rec_s |
|
473 |
|
|
474 |
avg_LC1_rec<-zonal(rast_diff,zones=LC1_rec,stat="mean",na.rm=TRUE) |
|
475 |
avg_LC2_rec<-zonal(rast_diff,zones=LC2_rec,stat="mean",na.rm=TRUE) |
|
476 |
avg_LC3_rec<-zonal(rast_diff,zones=LC3_rec,stat="mean",na.rm=TRUE) |
|
477 |
avg_LC4_rec<-zonal(rast_diff,zones=LC4_rec,stat="mean",na.rm=TRUE) |
|
478 |
avg_LC6_rec<-zonal(rast_diff,zones=LC6_rec,stat="mean",na.rm=TRUE) |
|
479 |
|
|
480 |
std_LC1_rec<-zonal(rast_diff,zones=LC1_rec,stat="sd",na.rm=TRUE) |
|
481 |
std_LC2_rec<-zonal(rast_diff,zones=LC2_rec,stat="sd",na.rm=TRUE) |
|
482 |
std_LC3_rec<-zonal(rast_diff,zones=LC3_rec,stat="sd",na.rm=TRUE) |
|
483 |
std_LC4_rec<-zonal(rast_diff,zones=LC4_rec,stat="sd",na.rm=TRUE) |
|
484 |
std_LC6_rec<-zonal(rast_diff,zones=LC6_rec,stat="sd",na.rm=TRUE) |
|
485 |
|
|
486 |
avg_LC_rec<-zonal(rast_diff,zones=LC_rec_s,stat="mean",na.rm=TRUE) |
|
487 |
std_LC_rec<-zonal(rast_diff,zones=LC_rec_s,stat="sd",na.rm=TRUE) |
|
488 |
|
|
489 |
zones_stat_std<-as.data.frame(cbind(std_LC1_rec,std_LC2_rec[,2],std_LC3_rec[,2],std_LC4_rec[,2],std_LC6_rec[,2])) |
|
490 |
zones_stat<-as.data.frame(cbind(avg_LC1_rec,avg_LC2_rec[,2],avg_LC3_rec[,2],avg_LC4_rec[,2],avg_LC6_rec[,2])) |
|
491 |
names(zones_stat)<-c("zones","LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban") |
|
492 |
names(zones_stat_std)<-c("zones","LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban") |
|
493 |
|
|
494 |
X11() |
|
495 |
plot(zones_stat$zones,zones_stat$LC1_forest,type="b",ylim=c(-4.5,4.5), |
|
496 |
ylab="difference between CAI and fusion",xlab="land cover percent class/10") |
|
497 |
lines(zones_stat$zones,zones_stat[,3],col="red",type="b") |
|
498 |
lines(zones_stat$zones,zones_stat[,4],col="blue",type="b") |
|
499 |
lines(zones_stat$zones,zones_stat[,5],col="darkgreen",type="b") |
|
500 |
lines(zones_stat$zones,zones_stat[,6],col="purple",type="b") |
|
501 |
legend("topleft",legend=c("LC1_forest", "LC2_shrub", "LC3_grass", "LC4_crop", "LC6_urban"), |
|
502 |
cex=1.2, col=c("black","red","blue","darkgreen","purple"), |
|
503 |
lty=1) |
|
504 |
title(paste("Prediction tmax difference and land cover ",sep="")) |
|
505 |
|
|
506 |
savePlot(paste("fig6_diff_prediction_tmax_difference_land cover",date_selected,out_prefix,".png", sep=""), type="png") |
|
507 |
dev.off() |
|
508 |
|
|
509 |
avl<-c(0,500,1,500,1000,2,1000,1500,3,1500,2000,4,2000,2500,5,2500,4000,6) |
|
510 |
rclmat<-matrix(avl,ncol=3,byrow=TRUE) |
|
511 |
elev_rec<-reclass(ELEV_SRTM,rclmat) #Loss of layer names when using reclass |
|
512 |
|
|
513 |
elev_rec_forest<-elev_rec*LC1_100_m |
|
514 |
avg_elev_rec<-zonal(rast_diff,zones=elev_rec,stat="mean",na.rm=TRUE) |
|
515 |
std_elev_rec<-zonal(rast_diff,zones=elev_rec,stat="sd",na.rm=TRUE) |
|
516 |
avg_elev_rec_forest<-zonal(rast_diff,zones=elev_rec_forest,stat="mean",na.rm=TRUE) |
|
517 |
std_elev_rec_forest<-zonal(rast_diff,zones=elev_rec_forest,stat="sd",na.rm=TRUE) |
|
518 |
|
|
519 |
|
|
520 |
|
|
521 |
## CREATE plots |
|
522 |
X11() |
|
523 |
plot(avg_elev_rec[,1],avg_elev_rec[,2],type="b",ylim=c(-10,1), |
|
524 |
ylab="difference between CAI and fusion",xlab="elevation classes") |
|
525 |
lines(avg_elev_rec_forest[,1],avg_elev_rec_forest[,2],col="green",type="b") #Elevation and 100% forest... |
|
526 |
legend("topright",legend=c("Elevation", "elev_forest"), |
|
527 |
cex=1.2, col=c("black","darkgreen"), |
|
528 |
lty=1) |
|
529 |
title(paste("Prediction tmax difference and elevation ",sep="")) |
|
530 |
savePlot(paste("fig7_diff_prediction_tmax_difference_elevation",date_selected,out_prefix,".png", sep=""), type="png") |
|
531 |
dev.off() |
|
532 |
#Add plots with std as CI |
|
533 |
|
|
534 |
} |
|
535 |
|
|
536 |
################################################################### |
|
537 |
################ TRANSECT THROUGH THE IMAGE: #################### |
|
538 |
|
|
539 |
#select date |
|
540 |
dates<-c("20100103","20100901") |
|
541 |
j=1 |
|
542 |
|
|
543 |
for (j in 1:length(dates)){ |
|
544 |
|
|
545 |
#Read predicted tmax raster surface and modeling information |
|
546 |
date_selected<-dates[j] |
|
547 |
oldpath<-getwd() |
|
548 |
setwd(path_data_cai) |
|
549 |
file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_CAI2_const_all_10312012.rst",sep="")) #Search for files in relation to fusion |
|
550 |
lf_cai2c<-list.files(pattern=file_pat) #Search for files in relation to fusion |
|
551 |
rast_cai2c<-stack(lf_cai2c) #lf_cai2c CAI results with constant sampling over 365 dates |
|
552 |
rast_cai2c<-mask(rast_cai2c,mask_ELEV_SRTM) |
|
553 |
|
|
554 |
oldpath<-getwd() |
|
555 |
setwd(path_data_fus) |
|
556 |
file_pat<-glob2rx(paste("*tmax_predicted*",date_selected,"*_365d_GAM_fusion_const_all_lstd_11022012.rst",sep="")) #Search for files in relation to fusion |
|
557 |
lf_fus1c<-list.files(pattern=file_pat) #Search for files in relation to fusion |
|
558 |
rast_fus1c<-stack(lf_fus1c) |
|
559 |
rast_fus1c<-mask(rast_fus1c,mask_ELEV_SRTM) |
|
560 |
|
|
561 |
setwd(path) |
|
562 |
rast_fus_pred<-raster(rast_fus1c,1) |
|
563 |
rast_cai_pred<-raster(rast_cai2c,1) |
|
564 |
rast_diff_fc<-rast_fus_pred-rast_cai_pred |
|
565 |
#Read in data_s and data_v |
|
566 |
|
|
567 |
|
|
568 |
### CREATE A NEW TRANSECT BASED ON LOCATION OF SPECIFIED STATIONS |
|
569 |
|
|
570 |
selected_stations<-c("USW00024284","USC00354126","USC00358536","USC00354835", |
|
571 |
"USC00356252","USC00359316","USC00358246","USC00350694", |
|
572 |
"USC00350699","USW00024230","USC00353542") |
|
573 |
#add which one were training and testing |
|
574 |
data_vf$training<-rep(0,nrow(data_vf)) |
|
575 |
data_sf$training<-rep(1,nrow(data_sf)) |
|
576 |
|
|
577 |
data_stat<-rbind(data_vf[,c("id","training")],data_sf[,c("id","training")]) |
|
578 |
m<-match(selected_stations,data_stat$id) |
|
579 |
|
|
580 |
trans4_stations<-transect_from_spdf(data_stat,m) |
|
581 |
#tmp<-as.data.frame(data_stat[1,]) |
|
582 |
#row.names(tmp)<-rep("X",1) |
|
583 |
#test<-SpatialLinesDataFrame(trans4_stations,data=tmp) |
|
584 |
writeOGR(obj=trans4_stations,layer="t4_line",dsn="t4_line.shp",driver="ESRI Shapefile", overwrite=T) |
|
585 |
## Create list of transect |
|
586 |
|
|
587 |
list_transect<-vector("list",nb_transect) |
|
588 |
list_transect[[1]]<-c("t1_line.shp",paste("figure_9_tmax_transect1_OR",date_selected,out_prefix,sep="_")) |
|
589 |
list_transect[[2]]<-c("t2_line.shp",paste("figure_10_tmax_transect2_OR",date_selected,out_prefix,sep="_")) |
|
590 |
list_transect[[3]]<-c("t3_line.shp",paste("figure_11_tmax_transect3_OR",date_selected,out_prefix,sep="_")) |
|
591 |
list_transect[[4]]<-c("t4_line.shp",paste("figure_12_tmax_transect4_OR",date_selected,out_prefix,sep="_")) |
|
592 |
|
|
593 |
names(list_transect)<-c("transect_OR1","transect_OR2","transect_OR3","transect_OR4") |
|
594 |
|
|
595 |
#now add a transect for elevation |
|
596 |
list_transect2<-vector("list",nb_transect) |
|
597 |
list_transect2[[1]]<-c("t1_line.shp",paste("figure_13_tmax_elevation_transect1_OR",date_selected,out_prefix,sep="_")) |
|
598 |
list_transect2[[2]]<-c("t2_line.shp",paste("figure_14_tmax_elevation_transect2_OR",date_selected,out_prefix,sep="_")) |
|
599 |
list_transect2[[3]]<-c("t3_line.shp",paste("figure_15_tmax_elevation_transect3_OR",date_selected,out_prefix,sep="_")) |
|
600 |
list_transect2[[4]]<-c("t4_line.shp",paste("figure_16_tmax_elevation_transect3_OR",date_selected,out_prefix,sep="_")) |
|
601 |
|
|
602 |
names(list_transect2)<-c("transect_OR1","transect_OR2","transect_OR3","transect_OR4") |
|
603 |
|
|
604 |
rast_pred<-stack(rast_fus_pred,rast_cai_pred) |
|
605 |
rast_pred2<-stack(rast_fus_pred,rast_cai_pred,ELEV_SRTM) |
|
606 |
layerNames(rast_pred)<-c("fus","CAI") |
|
607 |
layerNames(rast_pred2)<-c("fus","CAI","elev") |
|
608 |
title_plot<-paste(names(list_transect),date_selected) |
|
609 |
title_plot2<-paste(names(list_transect2),date_selected) |
|
610 |
#r_stack<-rast_pred |
|
611 |
|
|
612 |
X11(width=9,height=9) |
|
613 |
nb_transect<-length(list_transect) |
|
614 |
s_range<-c(minValue(rast_diff_fc),maxValue(rast_diff_fc)) #stack min and max |
|
615 |
col_breaks <- pretty(s_range, n=50) |
|
616 |
lab_breaks <- pretty(s_range, n=7) |
|
617 |
temp_colors <- colorRampPalette(c('blue', 'white', 'red')) |
|
618 |
plot(rast_diff_fc, breaks=col_breaks, col=temp_colors(length(col_breaks)-1), |
|
619 |
axis=list(at=lab_breaks, labels=lab_breaks)) |
|
620 |
for (k in 1:nb_transect){ |
|
621 |
trans_file<-list_transect[[k]] |
|
622 |
filename<-sub(".shp","",trans_file) #Removing the extension from file. |
|
623 |
transect<-readOGR(".", filename) #reading shapefile |
|
624 |
plot(transect,add=TRUE) |
|
625 |
} |
|
626 |
|
|
627 |
savePlot(paste("fig8_diff_transect_path_tmax_diff_CAI_fusion_",date_selected,out_prefix,".png", sep=""), type="png") |
|
628 |
dev.off() |
|
629 |
|
|
630 |
X11(width=18,height=9) |
|
631 |
m_layers_sc<-c(3) |
|
632 |
trans_data<-plot_transect(list_transect,rast_pred,title_plot,disp=TRUE) |
|
633 |
|
|
634 |
trans_data2<-plot_transect_m(list_transect2,rast_pred2,title_plot2,disp=TRUE,m_layers_sc) |
|
635 |
dev.off() |
|
636 |
|
|
637 |
|
|
638 |
X11(width=18,height=9) |
|
639 |
trans_elev<-vector("list",nb_transect) |
|
640 |
for (k in 1:nb_transect){ |
|
641 |
|
|
642 |
trans_file<-list_transect[[k]] |
|
643 |
filename<-sub(".shp","",trans_file) #Removing the extension from file. |
|
644 |
transect<-readOGR(".", filename) #reading shapefile |
|
645 |
trans_elev[[k]]<-extract(ELEV_SRTM,transect) |
|
646 |
y<-as.numeric(trans_elev[[k]][[1]]) |
|
647 |
elev_y<-y |
|
648 |
x<-1:length(y) |
|
649 |
plot(x,y,type="l", ylab="Elevation (in meters)",xlab="Transect position (in km)") |
|
650 |
data_y<-(trans_data[[k]][[1]]) # data for the first transect |
|
651 |
#as.data.frame(data_y) |
|
652 |
par(new=TRUE) # key: ask for new plot without erasing old |
|
653 |
y<-data_y[,1] |
|
654 |
x <- 1:length(y) |
|
655 |
fus_y<-y |
|
656 |
plot(x,y,type="l",col="red",axes=F) #plotting fusion profile |
|
657 |
axis(4,xlab="",ylab="tmax (in degree C)") |
|
658 |
y<-data_y[,2] |
|
659 |
cai_y<-y |
|
660 |
lines(x,y,col="green") |
|
661 |
|
|
662 |
#title(title_plot[i])) |
|
663 |
legend("topleft",legend=c("elev","fus","CAI"), |
|
664 |
cex=1.2, col=c("black","red","green"), |
|
665 |
lty=1) |
|
666 |
savePlot(file=paste(list_transect[[k]][2],".png",sep=""),type="png") |
|
667 |
|
|
668 |
cor(fus_y,elev_y) |
|
669 |
cor(cai_y,elev_y) |
|
670 |
cor(fus_y,cai_y) |
|
671 |
} |
|
672 |
dev.off |
|
673 |
|
|
674 |
} |
Also available in: Unified diff
Methods comp part5-task#491- initial commit, residuals analyses with focus on differences,land cover and covariates plots