Revision 92551b87
Added by Benoit Parmentier almost 12 years ago
climate/research/oregon/interpolation/results_interpolation_date_output_analyses.R | ||
---|---|---|
39 | 39 |
raster_prediction_obj<-"raster_prediction_obj__365d_GAM_fus5_all_lstd_03132013.RData" |
40 | 40 |
#out_prefix<-"_365d_GAM_fus5_all_lstd_03132013" |
41 | 41 |
#out_prefix<-"_365d_GAM_fus5_all_lstd_03142013" #User defined output prefix |
42 |
out_prefix<-"_365d_GAM_fus5_all_lstd_03132013" #User defined output prefix
|
|
42 |
out_prefix<-"_365d_GAM_fus5_all_lstd_03272013" #User defined output prefix
|
|
43 | 43 |
var<-"TMAX" |
44 | 44 |
#gam_fus_mod<-load_obj("gam_fus_mod_365d_GAM_fus5_all_lstd_02202013.RData") |
45 | 45 |
#validation_obj<-load_obj("gam_fus_validation_mod_365d_GAM_fus5_all_lstd_02202013.RData") |
... | ... | |
72 | 72 |
env[[nm]] |
73 | 73 |
} |
74 | 74 |
|
75 |
extract_number_obs<-function(list_param){ |
|
76 |
|
|
77 |
method_mod_obj<-list_param$method_mod_obj |
|
78 |
#Change to results_mod_obj[[i]]$data_s to make it less specific |
|
79 |
lapply(1:length(method_obj),function(k) nrow(method_mod_obj[[k]]$data_s)) |
|
80 |
lapply(1:length(method_obj),function(k) nrow(method_mod_obj[[k]]$data_v)) |
|
81 |
lapply(1:length(clim_obj),function(k) nrow(method_mod_obj[[k]]$data_v)) |
|
82 |
return() |
|
83 |
} |
|
84 | 75 |
|
85 | 76 |
### PLOTTING RESULTS FROM VENEZUELA INTERPOLATION FOR ANALYSIS |
86 | 77 |
#source(file.path(script_path,"results_interpolation_date_output_analyses_03182013.R")) |
... | ... | |
114 | 105 |
s_raster<-brick(infile_covar) #read in the data stack |
115 | 106 |
names(s_raster)<-covar_names #Assigning names to the raster layers: making sure it is included in the extraction |
116 | 107 |
|
117 |
## Figure 0: study area based on LC12 (water) mask
|
|
108 |
## Prepare study area mask: based on LC12 (water)
|
|
118 | 109 |
|
119 | 110 |
LC_mask<-subset(s_raster,"LC12") |
120 | 111 |
LC_mask[LC_mask==100]<-NA |
121 | 112 |
LC_mask <- LC_mask < 100 |
122 | 113 |
LC_mask_rec<-LC_mask |
123 | 114 |
LC_mask_rec[is.na(LC_mask_rec)]<-0 |
124 |
|
|
125 |
#Add proportion covered by study area+ total of image pixels |
|
126 |
tmp_tb<-freq(LC_mask_rec) |
|
127 |
tmp_tb[2,2]/sum(tmp_tb[,2])*100 |
|
128 |
png(paste("Study_area_", |
|
129 |
out_prefix,".png", sep="")) |
|
130 |
plot(LC_mask_rec,legend=FALSE,col=c("black","red")) |
|
131 |
legend("topright",legend=c("Outside","Inside"),title="Study area", |
|
132 |
pt.cex=0.9,fill=c("black","red"),bty="n") |
|
133 |
title("Study area") |
|
134 |
dev.off() |
|
135 |
|
|
115 |
|
|
136 | 116 |
#determine index position matching date selected |
137 | 117 |
|
138 | 118 |
for (j in 1:length(date_selected)){ |
... | ... | |
295 | 275 |
|
296 | 276 |
} |
297 | 277 |
|
298 |
|
|
299 |
|
|
300 |
## Summarize information for the day: write out textfile... |
|
301 |
|
|
302 |
#Number of station per month |
|
303 |
#Number of station per day (training, testing,NA) |
|
304 |
#metrics_v,metrics_s |
|
305 |
# |
|
306 |
|
|
307 |
# ################ |
|
308 |
# #PART 2: Region Covariate analyses ### |
|
309 |
# ################ |
|
310 |
# |
|
311 |
# # This should be in a separate script to analyze covariates from region. |
|
312 |
# |
|
313 |
# #MAP1:Study area with LC mask and tiles/polygon outline |
|
314 |
# |
|
315 |
# |
|
316 |
# #MAP 2: plotting land cover in the study region: |
|
317 |
# |
|
318 |
# l1<-"LC1,Evergreen/deciduous needleleaf trees" |
|
319 |
# l2<-"LC2,Evergreen broadleaf trees" |
|
320 |
# l3<-"LC3,Deciduous broadleaf trees" |
|
321 |
# l4<-"LC4,Mixed/other trees" |
|
322 |
# l5<-"LC5,Shrubs" |
|
323 |
# l6<-"LC6,Herbaceous vegetation" |
|
324 |
# l7<-"LC7,Cultivated and managed vegetation" |
|
325 |
# l8<-"LC8,Regularly flooded shrub/herbaceous vegetation" |
|
326 |
# l9<-"LC9,Urban/built-up" |
|
327 |
# l10<-"LC10,Snow/ice" |
|
328 |
# l11<-"LC11,Barren lands/sparse vegetation" |
|
329 |
# l12<-"LC12,Open water" |
|
330 |
# lc_names_str<-c(l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11,l12) |
|
331 |
# |
|
332 |
# names(lc_reg_s)<-lc_names_str |
|
333 |
# |
|
334 |
# png(paste("LST_TMax_scatterplot_",sampling_dat$date[i],"_",sampling_dat$prop[i],"_",sampling_dat$run_samp[i], out_prefix,".png", sep="")) |
|
335 |
# plot(modst$TMax,sta_tmax_from_lst,xlab="Station mo Tmax",ylab="LST mo Tmax",main=paste("LST vs TMax for",datelabel,sep=" ")) |
|
336 |
# abline(0,1) |
|
337 |
# nb_point<-paste("n=",length(modst$TMax),sep="") |
|
338 |
# mean_bias<-paste("LST bigrasas= ",format(mean(modst$LSTD_bias,na.rm=TRUE),digits=3),sep="") |
|
339 |
# #Add the number of data points on the plot |
|
340 |
# legend("topleft",legend=c(mean_bias,nb_point),bty="n") |
|
341 |
# dev.off() |
|
342 |
# |
|
343 |
# #Map 3: Elevation and LST in January |
|
344 |
# tmp_s<-stack(LST,elev_1) |
|
345 |
# png(paste("LST_elev_",sampling_dat$date[i],"_",sampling_dat$prop[i],"_",sampling_dat$run_samp[i], out_prefix,".png", sep="")) |
|
346 |
# plot(tmp_s) |
|
347 |
# |
|
348 |
# #Map 4: LST climatology per month |
|
349 |
# |
|
350 |
# 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") |
|
351 |
# LST_s<-subset(s_raster,names_tmp) |
|
352 |
# names_tmp<-c("nobs_01","nobs_02","nobs_03","nobs_04","nobs_05","nobs_06","nobs_07","nobs_08", |
|
353 |
# "nobs_09","nobs_10","nobs_11","nobs_12") |
|
354 |
# LST_nobs<-subset(s_raster,names_tmp) |
|
355 |
# |
|
356 |
# LST_nobs<-mask(LST_nobs,LC_mask,filename="test2.tif") |
|
357 |
# LST_s<-mask(LST_s,LC_mask,filename="test3.tif") |
|
358 |
# c("Jan","Feb") |
|
359 |
# plot(LST_s) |
|
360 |
# plot(LST_nobs) |
|
361 |
# |
|
362 |
# #Map 5: LST and TMax |
|
363 |
# |
|
364 |
# #note differnces in patternin agricultural areas and |
|
365 |
# min_values<-cellStats(LST_s,"min") |
|
366 |
# max_values<-cellStats(LST_s,"max") |
|
367 |
# mean_values<-cellStats(LST_s,"mean") |
|
368 |
# sd_values<-cellStats(LST_s,"sd") |
|
369 |
# #median_values<-cellStats(molst,"median") Does not extist |
|
370 |
# statistics_LST_s<-cbind(min_values,max_values,mean_values,sd_values) #This shows that some values are extremes...especially in October |
|
371 |
# LST_stat_data<-as.data.frame(statistics_LST_s) |
|
372 |
# names(LST_stat_data)<-c("min","max","mean","sd") |
|
373 |
# # Statistics for number of valid observation stack |
|
374 |
# min_values<-cellStats(nobslst,"min") |
|
375 |
# max_values<-cellStats(nobslst,"max") |
|
376 |
# mean_values<-cellStats(nobslst,"mean") |
|
377 |
# sd_values<-cellStats(nobslst,"sd") |
|
378 |
# statistics_LSTnobs_s<-cbind(min_values,max_values,mean_values,sd_values) #This shows that some values are extremes...especially in October |
|
379 |
# LSTnobs_stat_data<-as.data.frame(statistics_LSTnobs_s) |
|
380 |
# |
|
381 |
# X11(width=12,height=12) |
|
382 |
# #Plot statiscs (mean,min,max) for monthly LST images |
|
383 |
# plot(1:12,LST_stat_data$mean,type="b",ylim=c(-15,60),col="black",xlab="month",ylab="tmax (degree C)") |
|
384 |
# lines(1:12,LST_stat_data$min,type="b",col="blue") |
|
385 |
# lines(1:12,LST_stat_data$max,type="b",col="red") |
|
386 |
# text(1:12,LST_stat_data$mean,rownames(LST_stat_data),cex=1,pos=2) |
|
387 |
# |
|
388 |
# legend("topleft",legend=c("min","mean","max"), cex=1.5, col=c("blue","black","red"), |
|
389 |
# lty=1) |
|
390 |
# title(paste("LST statistics for Oregon", "2010",sep=" ")) |
|
391 |
# savePlot("lst_statistics_OR.png",type="png") |
|
392 |
# |
|
393 |
# #Plot number of valid observations for LST |
|
394 |
# plot(1:12,LSTnobs_stat_data$mean,type="b",ylim=c(0,280),col="black",xlab="month",ylab="tmax (degree C)") |
|
395 |
# lines(1:12,LSTnobs_stat_data$min,type="b",col="blue") |
|
396 |
# lines(1:12,LSTnobs_stat_data$max,type="b",col="red") |
|
397 |
# text(1:12,LSTnobs_stat_data$mean,rownames(LSTnobs_stat_data),cex=1,pos=2) |
|
398 |
# |
|
399 |
# legend("topleft",legend=c("min","mean","max"), cex=1.5, col=c("blue","black","red"), |
|
400 |
# lty=1) |
|
401 |
# title(paste("LST number of valid observations for Oregon", "2010",sep=" ")) |
|
402 |
# savePlot("lst_nobs_OR.png",type="png") |
|
403 |
# |
|
404 |
# plot(data_month$TMax,add=TRUE) |
|
405 |
# |
|
406 |
# ### Map 6: station in the region |
|
407 |
# |
|
408 |
# plot(tmax_predicted) |
|
409 |
# plot(data_s,col="black",cex=1.2,pch=4,add=TRUE) |
|
410 |
# plot(data_v,col="blue",cex=1.2,pch=2,add=TRUE) |
|
411 |
# |
|
412 |
# plot(tmax_predicted) |
|
413 |
# plot(data_month,col="black",cex=1.2,pch=4,add=TRUE) |
|
414 |
# title("Monthly ghcn station in Venezuela for 2000-2010") |
|
415 |
# |
|
416 |
#png...output? |
|
417 |
# plot(interp_area, axes =TRUE) |
|
418 |
# plot(stat_reg, pch=1, col="red", cex= 0.7, add=TRUE) |
|
419 |
# plot(data_reg,pch=2,col="blue",cex=2,add=TRUE) |
|
420 |
|
|
421 |
#### End of script #### |
Also available in: Unified diff
Results output analyses, splitting code for covariates output summary