Revision 1d0a0b81
Added by Benoit Parmentier almost 12 years ago
| climate/research/oregon/interpolation/GAM_fusion_function_multisampling_validation_metrics.R | ||
|---|---|---|
| 16 | 16 |
#Function used in the script |
| 17 | 17 |
|
| 18 | 18 |
calculate_accuracy_metrics<-function(i,list_param){
|
| 19 |
|
|
| 19 |
library(plyr) |
|
| 20 | 20 |
### Caculate accuracy metrics |
| 21 | 21 |
calc_val_metrics<-function(x,y){
|
| 22 | 22 |
#This functions calculates accurayc metrics on given two vectors. |
| ... | ... | |
| 124 | 124 |
|
| 125 | 125 |
boxplot_from_tb <-function(tb_diagnostic,metric_names,out_prefix){
|
| 126 | 126 |
#now boxplots and mean per models |
| 127 |
mod_names<-unique(tb_diagnostic$pred_mod) #models that have accuracy metrics
|
|
| 127 |
mod_names<-sort(unique(tb_diagnostic$pred_mod)) #models that have accuracy metrics
|
|
| 128 | 128 |
t<-melt(tb_diagnostic, |
| 129 | 129 |
#measure=mod_var, |
| 130 | 130 |
id=c("date","pred_mod","prop"),
|
| ... | ... | |
| 133 | 133 |
|
| 134 | 134 |
median_tb<-cast(t,pred_mod~variable,median) |
| 135 | 135 |
tb<-tb_diagnostic |
| 136 |
tb_mod_list<-vector("list",length(mod_names))
|
|
| 137 |
for(i in 1:length(mod_names)){ # Reorganizing information in terms of metrics
|
|
| 138 |
mod_name_tb<-paste("tb_",mod_names[i],sep="")
|
|
| 139 |
tb_mod<-subset(tb, pred_mod==mod_names[i]) |
|
| 140 |
assign(mod_name_tb,tb_mod) |
|
| 141 |
tb_mod_list[[i]]<-tb_mod |
|
| 142 |
} |
|
| 136 |
|
|
| 137 |
#mod_names<-sort(unique(tb$pred_mod)) #kept for clarity |
|
| 138 |
tb_mod_list<-lapply(mod_names, function(k) subset(tb, pred_mod==k)) #this creates a list of 5 based on models names |
|
| 143 | 139 |
names(tb_mod_list)<-mod_names |
| 144 |
mod_metrics<-do.call(cbind,tb_mod_list) |
|
| 140 |
#mod_metrics<-do.call(cbind,tb_mod_list) |
|
| 141 |
mod_metrics<-do.call(cbindX,tb_mod_list) |
|
| 142 |
test_names<-lapply(1:length(mod_names),function(k) paste(names(tb_mod_list[[1]]),mod_names[k],sep="_")) |
|
| 143 |
names(mod_metrics)<-unlist(test_names) |
|
| 144 |
rows_total<-lapply(tb_mod_list,nrow) |
|
| 145 | 145 |
for (j in 1:length(metric_names)){
|
| 146 | 146 |
metric_ac<-metric_names[j] |
| 147 |
mod_pat<-glob2rx(paste("*.",metric_ac,sep=""))
|
|
| 147 |
mod_pat<-glob2rx(paste(metric_ac,"_*",sep=""))
|
|
| 148 | 148 |
mod_var<-grep(mod_pat,names(mod_metrics),value=TRUE) # using grep with "value" extracts the matching names |
| 149 | 149 |
#browser() |
| 150 | 150 |
test<-mod_metrics[mod_var] |
| 151 | 151 |
png(paste("boxplot_metric_",metric_ac, out_prefix,".png", sep=""))
|
| 152 | 152 |
boxplot(test,outline=FALSE,horizontal=FALSE,cex=0.5, |
| 153 | 153 |
ylab=paste(metric_ac,"in degree C",sep=" ")) |
| 154 |
#legend("bottomleft",legend=paste(names(rows_total),":",rows_total,sep=""),cex=0.7,bty="n")
|
|
| 155 |
title(as.character(t(paste(t(names(rows_total)),":",rows_total,sep=""))),cex=0.8) |
|
| 154 | 156 |
dev.off() |
| 155 | 157 |
} |
| 158 |
avg_tb$n<-rows_total #total number of predictions on which the mean is based |
|
| 159 |
median_tb$n<-rows_total |
|
| 156 | 160 |
summary_obj<-list(avg_tb,median_tb) |
| 157 | 161 |
return(summary_obj) |
| 158 | 162 |
} |
| ... | ... | |
| 162 | 166 |
#Add code here... |
| 163 | 167 |
} |
| 164 | 168 |
|
| 169 |
|
|
| 170 |
|
|
| 171 |
|
|
| 165 | 172 |
#################################### |
| 166 | 173 |
############ END OF SCRIPT ######### |
Also available in: Unified diff
VValidation script, average over 365 days take into account no predictions and number of predictions