Revision 94e49513
Added by Benoit Parmentier about 11 years ago
| climate/research/oregon/interpolation/multi_timescales_paper_interpolation_functions.R | ||
|---|---|---|
| 5 | 5 |
#Functions used in the production of figures and data for the multi timescale paper are recorded. |
| 6 | 6 |
#AUTHOR: Benoit Parmentier # |
| 7 | 7 |
#DATE CREATED: 11/25/2013 |
| 8 |
#DATE MODIFIED: 12/04/2013
|
|
| 8 |
#DATE MODIFIED: 12/09/2013
|
|
| 9 | 9 |
#Version: 1 |
| 10 | 10 |
#PROJECT: Environmental Layers project # |
| 11 | 11 |
################################################################################################# |
| ... | ... | |
| 30 | 30 |
|
| 31 | 31 |
#### FUNCTION USED IN SCRIPT |
| 32 | 32 |
|
| 33 |
function_analyses_paper <-"multi_timescales_paper_interpolation_functions_11022013.R"
|
|
| 33 |
function_analyses_paper <-"multi_timescales_paper_interpolation_functions_12092013.R"
|
|
| 34 | 34 |
|
| 35 | 35 |
plot_transect_m2<-function(list_trans,r_stack,title_plot,disp=FALSE,m_layers){
|
| 36 | 36 |
#This function creates plot of transects for stack of raster images. |
| ... | ... | |
| 187 | 187 |
return(dat_var_stat) |
| 188 | 188 |
} |
| 189 | 189 |
|
| 190 |
plot_accuracy_by_holdout_fun <-function(list_tb,ac_metric){
|
|
| 191 |
# |
|
| 192 |
list_plots <- vector("list",length=length(list_tb))
|
|
| 193 |
for (i in 1:length(list_tb)){
|
|
| 194 |
#i <- i+1 |
|
| 195 |
tb <-list_tb[[i]] |
|
| 196 |
plot_name <- names(list_tb)[i] |
|
| 197 |
pat_str <- "tb_m" |
|
| 198 |
if(substr(plot_name,start=1,stop=4)== pat_str){
|
|
| 199 |
names_id <- c("pred_mod","prop")
|
|
| 200 |
plot_formula <- paste(ac_metric,"~prop",sep="",collapse="") |
|
| 201 |
}else{
|
|
| 202 |
names_id <- c("pred_mod","prop_month")
|
|
| 203 |
plot_formula <- paste(ac_metric,"~prop_month",collapse="") |
|
| 204 |
} |
|
| 205 |
names_mod <-unique(tb$pred_mod) |
|
| 206 |
prop_obj <- calc_stat_prop_tb_diagnostic(names_mod,names_id,tb) |
|
| 207 |
avg_tb <- prop_obj$avg_tb |
|
| 208 |
|
|
| 209 |
layout_m<-c(1,1) #one row two columns |
|
| 210 |
par(mfrow=layout_m) |
|
| 211 |
|
|
| 212 |
#add option for plot title? |
|
| 213 |
png(paste("Figure__accuracy_",ac_metric,"_prop_month_",plot_name,"_",out_prefix,".png", sep=""),
|
|
| 214 |
height=480*layout_m[1],width=480*layout_m[2]) |
|
| 215 |
|
|
| 216 |
p <- xyplot(as.formula(plot_formula),group=pred_mod,type="b", |
|
| 217 |
data=avg_tb, |
|
| 218 |
main=paste(ac_metric,plot_name,sep=" "), |
|
| 219 |
pch=1:length(avg_tb$pred_mod), |
|
| 220 |
par.settings=list(superpose.symbol = list( |
|
| 221 |
pch=1:length(avg_tb$pred_mod))), |
|
| 222 |
auto.key=list(columns=5)) |
|
| 223 |
print(p) |
|
| 224 |
|
|
| 225 |
dev.off() |
|
| 226 |
list_plots[[i]] <- p |
|
| 227 |
} |
|
| 228 |
names(list_plots) <- names |
|
| 229 |
return(list_plots) |
|
| 230 |
#end of function |
|
| 231 |
} |
|
| 190 | 232 |
|
| 191 | 233 |
################### END OF SCRIPT ################### |
| 192 | 234 |
|
Also available in: Unified diff
multi timescale function script, update