Revision 617d83ff
Added by Benoit Parmentier over 11 years ago
| climate/research/oregon/interpolation/GAM_fusion_function_multisampling_validation_metrics.R | ||
|---|---|---|
| 2 | 2 |
|
| 3 | 3 |
#The interpolation is done first at the monthly add delta. |
| 4 | 4 |
#AUTHOR: Benoit Parmentier |
| 5 |
#DATE: 03/27/2013
|
|
| 5 |
#DATE: 05/01/2013
|
|
| 6 | 6 |
|
| 7 | 7 |
#Change this to allow explicitly arguments... |
| 8 | 8 |
#Arguments: |
| ... | ... | |
| 166 | 166 |
boxplot(test,outline=FALSE,horizontal=FALSE,cex=0.5, |
| 167 | 167 |
ylab=paste(metric_ac,"in degree C",sep=" ")) |
| 168 | 168 |
#legend("bottomleft",legend=paste(names(rows_total),":",rows_total,sep=""),cex=0.7,bty="n")
|
| 169 |
title(as.character(t(paste(t(names(rows_total)),":",rows_total,sep=""))),cex=0.8) |
|
| 169 |
#title(as.character(t(paste(t(names(rows_total)),":",rows_total,sep=""))),cex=0.8) |
|
| 170 |
title(paste(metric_ac,"for",y_var_name,sep=" "),cex=0.8) |
|
| 170 | 171 |
dev.off() |
| 171 | 172 |
} |
| 173 |
|
|
| 172 | 174 |
avg_tb$n<-rows_total #total number of predictions on which the mean is based |
| 173 | 175 |
median_tb$n<-rows_total |
| 174 | 176 |
summary_obj<-list(avg_tb,median_tb) |
| 175 | 177 |
return(summary_obj) |
| 176 | 178 |
} |
| 177 |
|
|
| 179 |
#boxplot_month_from_tb(tb_diagnostic,metric_names,out_prefix) |
|
| 178 | 180 |
## Function to display metrics by months/seasons |
| 179 | 181 |
boxplot_month_from_tb <-function(tb_diagnostic,metric_names,out_prefix){
|
| 180 |
#Add code here... |
|
| 182 |
|
|
| 183 |
#Generate boxplot per month for models and accuracy metrics |
|
| 184 |
#Input parameters: |
|
| 185 |
#1) df: data frame containing accurayc metrics (RMSE etc.) per day) |
|
| 186 |
#2) metric_names: metrics used for validation |
|
| 187 |
#3) out_prefix |
|
| 188 |
# |
|
| 189 |
|
|
| 190 |
################# |
|
| 191 |
## BEGIN |
|
| 192 |
|
|
| 181 | 193 |
date_f<-strptime(tb_diagnostic$date, "%Y%m%d") # interpolation date being processed |
| 182 | 194 |
tb_diagnostic$month<-strftime(date_f, "%m") # current month of the date being processed |
| 183 | 195 |
mod_names<-sort(unique(tb_diagnostic$pred_mod)) #models that have accuracy metrics |
| 184 | 196 |
tb_mod_list<-lapply(mod_names, function(k) subset(tb_diagnostic, pred_mod==k)) #this creates a list of 5 based on models names |
| 185 | 197 |
names(tb_mod_list)<-mod_names |
| 186 |
agg_by_month <-function(tb_mod_list,j,metric_names){
|
|
| 187 |
for (k in 1:length(metric_names)){
|
|
| 188 |
metric_ac<-metric_names[k] |
|
| 189 |
mod_pat<-glob2rx(paste(metric_ac,"_*",sep="")) |
|
| 190 |
mod_var<-grep(mod_pat,names(mod_metrics),value=TRUE) # using grep with "value" extracts the matching names |
|
| 191 |
d_month<-aggregate(metric_n~month, data=tb_mod_list[[j]], mean) #Calculate monthly mean for every station in OR |
|
| 192 |
} |
|
| 193 |
return(d_month) |
|
| 194 |
} |
|
| 195 |
test<-lapply(1:length(tb_mod_list),FUN=agg_by_month,tb_mod_list=tb_mod_list) |
|
| 196 |
|
|
| 197 | 198 |
t<-melt(tb_diagnostic, |
| 198 | 199 |
#measure=mod_var, |
| 199 | 200 |
id=c("date","pred_mod","prop","month"),
|
| 200 | 201 |
na.rm=F) |
| 201 |
test<-cast(t,pred_mod+month~variable,mean) |
|
| 202 |
tb_mod_list<-lapply(mod_names, function(k) subset(tb_diagnostic, pred_mod==k)) #this creates a list of 5 based on models names |
|
| 203 |
for (k in 1:tb_mod_m_ist){
|
|
| 204 |
for (j in 1:length(metric_names)){
|
|
| 202 |
tb_mod_m_avg <-cast(t,pred_mod+month~variable,mean) #monthly mean for every model |
|
| 203 |
tb_mod_m_sd <-cast(t,pred_mod+month~variable,sd) #monthly sd for every model |
|
| 204 |
|
|
| 205 |
tb_mod_m_list <-lapply(mod_names, function(k) subset(tb_mod_m, pred_mod==k)) #this creates a list of 5 based on models names |
|
| 206 |
|
|
| 207 |
for (k in 1:length(mod_names)){
|
|
| 208 |
mod_metrics <-tb_mod_list[[k]] |
|
| 209 |
current_mod_name<- mod_names[k] |
|
| 210 |
for (j in 1:length(metric_names)){
|
|
| 205 | 211 |
metric_ac<-metric_names[j] |
| 206 |
mod_pat<-glob2rx(paste(metric_ac,"_*",sep="")) |
|
| 207 |
mod_var<-grep(mod_pat,names(mod_metrics),value=TRUE) # using grep with "value" extracts the matching names |
|
| 208 |
#browser() |
|
| 209 |
test<-mod_metrics[mod_var] |
|
| 210 |
png(paste("boxplot_metric_",metric_ac, out_prefix,".png", sep=""))
|
|
| 211 |
boxplot(test,outline=FALSE,horizontal=FALSE,cex=0.5, |
|
| 212 |
col_selected<-c(metric_ac,"month") |
|
| 213 |
test<-mod_metrics[col_selected] |
|
| 214 |
png(paste("boxplot_metric_",metric_ac,"_",current_mod_name,"_by_month_",out_prefix,".png", sep=""))
|
|
| 215 |
boxplot(test[[metric_ac]]~test[[c("month")]],outline=FALSE,horizontal=FALSE,cex=0.5,
|
|
| 212 | 216 |
ylab=paste(metric_ac,"in degree C",sep=" ")) |
| 213 | 217 |
#legend("bottomleft",legend=paste(names(rows_total),":",rows_total,sep=""),cex=0.7,bty="n")
|
| 214 |
title(as.character(t(paste(t(names(rows_total)),":",rows_total,sep=""))),cex=0.8)
|
|
| 218 |
title(paste(metric_ac,"for",current_mod_name,"by month",sep=" "))
|
|
| 215 | 219 |
dev.off() |
| 216 |
} |
|
| 220 |
} |
|
| 221 |
|
|
| 217 | 222 |
} |
| 218 |
|
|
| 219 |
|
|
| 220 |
|
|
| 223 |
summary_month_obj <-c(tb_mod_m_list,tb_mod_m_avg,tb_mod_m_sd) |
|
| 224 |
names(summary_month_obj)<-c("tb_list","metric_month_avg","metric_month_sd")
|
|
| 225 |
return(summary_month_obj) |
|
| 221 | 226 |
} |
| 222 | 227 |
|
| 223 | 228 |
|
| 224 |
|
|
| 225 |
|
|
| 226 | 229 |
#################################### |
| 227 | 230 |
############ END OF SCRIPT ######### |
Also available in: Unified diff
validation script function for monthly averages for accuracy metrics