diff options
Diffstat (limited to 'analysis/days.R')
| -rw-r--r-- | analysis/days.R | 137 |
1 files changed, 76 insertions, 61 deletions
diff --git a/analysis/days.R b/analysis/days.R index 0ecbc59..6ad721e 100644 --- a/analysis/days.R +++ b/analysis/days.R @@ -1,4 +1,5 @@ library("tidyverse") +options(dplyr.summarise.inform = FALSE) library("class") library("rpart") library("rpart.plot") @@ -25,55 +26,62 @@ nsimkey=4 nsimulations=nseed*nwakeupfor*nwireless*nsimkey # Must be 3200 ## Load data -data=read_csv("../CCGRID2022.csv")%>%distinct() # Note that in the data experiment wireless=="lora",seed==1,wakeupfor==60,simkey=="baseline" is present 2 times in the CSV file -tmp_data_coverage=data%>%group_by(simkey,wireless,wakeupfor,seed)%>%mutate(coverage=sum(nDataRcv))%>%ungroup()%>%filter(isSender==1)%>%select(simkey,wireless,wakeupfor,seed,coverage) -data_seed_isSender=data%>%group_by(simkey,wireless,wakeupfor,seed,isSender)%>%summarize(energy_mean=mean(energy))%>% - left_join(tmp_data_coverage,by=c("simkey","wireless","wakeupfor","seed"))%>% - mutate(efficiency=energy_mean/coverage)%>% - ungroup() +data=suppressMessages(read_csv("../CCGRID2022.csv"))%>%distinct() # Note that in the data experiment wireless=="lora",seed==1,wakeupfor==60,simkey=="baseline" is present 2 times in the CSV file data_seed=data%>%group_by(simkey,wireless,wakeupfor,seed)%>%summarize(energy=sum(energy),coverage=sum(nDataRcv))%>% mutate(efficiency=energy/coverage)%>% ungroup() +F1_Score2=function(truth, pred){ + result=sapply(c("baseline","extended","hint","hintandextended"),function(c){ + cur_truth=truth[truth==c] + cur_pred=pred[truth==c] + col=paste0("f1_",c) + score=F1_Score(cur_truth,cur_pred) + if(is.nan(score)){score=0} + list(tibble(!!col:=score)) + }) + do.call("cbind",result) +} + generate_accuracy_for=function(ignore_hint=FALSE,seed_max=200,attempts_max=2,wrl="lora",wuf=180) { attempts=seq(1,attempts_max) results=sapply(attempts,function(attempt){ - ## Prepare data for traning - set.seed(1+attempt) # Reproducibility - wireless_map=c("lora"=1,"nbiot"=2) - cur_data_seed=data_seed%>%filter(wakeupfor==wuf,wireless==wrl) - data_ml=cur_data_seed%>%select(-efficiency)%>%mutate(wireless=wireless_map[cur_data_seed$wireless]) - if(ignore_hint){ - data_ml=data_ml%>%filter(simkey!="hint") - } - train_set=data_ml%>%filter(seed<=seed_max)%>%select(-seed) # train data on seed_max*3 days - test_set=data_ml%>%anti_join(train_set)%>%select(-seed) # build test_sed excluding training set - - ## KNN training - knn_predictions=knn(train=train_set%>%select(-simkey),test=test_set%>%select(-simkey),cl=train_set$simkey,k=min(10,NROW(train_set))) - ## KNN analysis - knn_cont_table=table(knn_predictions,test_set$simkey) - knn_accuracy=round((sum(diag(knn_cont_table)/sum(rowSums(knn_cont_table))))*100) - knn_prop_table=round(prop.table(knn_cont_table),digits=2) - knn_f1_score=F1_Score(test_set$simkey,knn_predictions) - knn_recall=Recall(test_set$simkey,knn_predictions) - knn_precision=Precision(test_set$simkey,knn_predictions) + ## Prepare data for traning + set.seed(1+attempt) # Reproducibility + wireless_map=c("lora"=1,"nbiot"=2) + cur_data_seed=data_seed%>%filter(wakeupfor==wuf,wireless==wrl) + data_ml=cur_data_seed%>%select(-efficiency)%>%mutate(wireless=wireless_map[cur_data_seed$wireless]) + if(ignore_hint){ + data_ml=data_ml%>%filter(simkey!="hint") + } + train_set=data_ml%>%filter(seed<=seed_max)%>%select(-seed) # train data on seed_max*3 days + test_set=data_ml%>%suppressMessages(anti_join(train_set))%>%select(-seed) # build test_sed excluding training set + + ## KNN training + knn_predictions=knn(train=train_set%>%select(-simkey),test=test_set%>%select(-simkey),cl=train_set$simkey,k=min(10,NROW(train_set))) + ## KNN analysis + knn_cont_table=table(knn_predictions,test_set$simkey) + knn_accuracy=(sum(diag(knn_cont_table)/sum(rowSums(knn_cont_table)))) + knn_prop_table=round(prop.table(knn_cont_table),digits=2) + knn_f1_score=F1_Score2(test_set$simkey,knn_predictions) - ## Decision tree - tree=rpart( - simkey ~ wireless + wakeupfor + energy + coverage, - data=train_set, - method="class", - minsplit=60, - minbucket=1) - tree_predictions=predict(tree,newdata=test_set%>%select(-simkey),type="class") - tree_cont_table=table(tree_predictions,test_set$simkey) - tree_accuracy=round((sum(diag(tree_cont_table)/sum(rowSums(tree_cont_table))))*100) - tree_prop_table=round(prop.table(tree_cont_table),digits=2) - tree_f1_score=F1_Score(test_set$simkey,tree_predictions) - tree_recall=Recall(test_set$simkey,tree_predictions) - tree_precision=Precision(test_set$simkey,tree_predictions) - list(tibble(seed_max=seed_max,model=c("knn","tree"),accuracy=c(knn_accuracy,tree_accuracy),f1_score=c(knn_f1_score,tree_f1_score),recall=c(knn_recall,tree_recall),precision=c(knn_precision,tree_precision))) + ## Decision tree + tree=rpart( + simkey ~ wireless + wakeupfor + energy + coverage, + data=train_set, + method="class", + minsplit=60, + minbucket=1) + tree_predictions=predict(tree,newdata=test_set%>%select(-simkey),type="class") + tree_cont_table=table(tree_predictions,test_set$simkey) + tree_accuracy=(sum(diag(tree_cont_table)/sum(rowSums(tree_cont_table)))) + tree_prop_table=round(prop.table(tree_cont_table),digits=2) + tree_f1_score=F1_Score2(test_set$simkey,tree_predictions) + + ## Format data + result_data=tibble(seed_max=seed_max,model=c("knn","tree"),accuracy=c(knn_accuracy,tree_accuracy)) + result_data=cbind(result_data,rbind(knn_f1_score,tree_f1_score)) + list(result_data) }) ## Prints results=do.call("rbind",results) @@ -81,7 +89,7 @@ generate_accuracy_for=function(ignore_hint=FALSE,seed_max=200,attempts_max=2,wrl } -generate_accuracy = function(wireless,wakeupfor,steps=1, accuracy=20,ignore_hint=TRUE){ +generate_accuracy = function(wireless,wakeupfor,steps=10, accuracy=10,ignore_hint=TRUE){ npolicies=4 if(ignore_hint){npolicies=npolicies-1} ## Generate inputs @@ -94,36 +102,43 @@ generate_accuracy = function(wireless,wakeupfor,steps=1, accuracy=20,ignore_hint } # Generate accuracy for each wireless and uptime -accuracy=rbind(generate_accuracy("lora",60), - generate_accuracy("lora",180), - generate_accuracy("nbiot",60), - generate_accuracy("nbiot",180)) +#accuracy=rbind(generate_accuracy("lora",60), +# generate_accuracy("lora",180), +# generate_accuracy("nbiot",60), +# generate_accuracy("nbiot",180)) ## Summarize result_summary=accuracy%>%group_by(wireless,wakeupfor,months,model)%>% summarize( mean_accuracy=mean(accuracy),sd_accuracy=sd(accuracy),min_accuracy=min(accuracy),max_accuracy=max(accuracy), - mean_f1_score=mean(f1_score),sd_f1_score=sd(f1_score),min_f1_score=min(f1_score),max_f1_score=max(f1_score), - mean_recall=mean(recall),sd_recall=sd(recall),min_recall=min(recall),max_recall=max(recall), - mean_precision=mean(precision),sd_precision=sd(precision),min_precision=min(precision),max_precision=max(precision)) + mean_f1_baseline=mean(f1_baseline),sd_f1_baseline=sd(f1_baseline),min_f1_baseline=min(f1_baseline),max_f1_baseline=max(f1_baseline), + mean_f1_hint=mean(f1_hint),sd_f1_hint=sd(f1_hint),min_f1_hint=min(f1_hint),max_f1_hint=max(f1_hint), + mean_f1_extended=mean(f1_extended),sd_f1_extended=sd(f1_extended),min_f1_extended=min(f1_extended),max_f1_extended=max(f1_extended), + mean_f1_hintandextended=mean(f1_hintandextended),sd_f1_hintandextended=sd(f1_hintandextended),min_f1_hintandextended=min(f1_hintandextended),max_f1_hintandextended=max(f1_hintandextended)) ## Result max metrics_peak=result_summary%>%group_by(wireless,wakeupfor,model)%>% - summarize(max_accuracy=max(mean_accuracy), - max_f1_score=max(mean_f1_score), - max_recall=max(mean_recall), - max_precision=max(mean_precision)) + summarize(max_accuracy=max(mean_accuracy)) ## Plot sapply(c("knn","tree"),function(grp){ - ggplot(result_summary%>%filter(model==grp),aes(months,mean_accuracy))+ + data=result_summary%>%filter(model==grp) + plot=ggplot(data,aes(months,mean_accuracy))+ geom_ribbon(aes(ymin=mean_accuracy-sd_accuracy,ymax=mean_accuracy+sd_accuracy),alpha=0.2,color=NA)+ - geom_line(size=1.1)+geom_point(size=3)+xlab("Number of training months")+ylab(paste("Mean",grp,"accuracy"))+ggtitle(paste(grp,"accuracy"))+ -# ylim(c(0,100))+ - geom_hline(data=metrics_peak%>%filter(model==grp),aes(yintercept=max_accuracy),color="red",size=1)+ - geom_text(data=metrics_peak%>%filter(model==grp),x=0,aes(y=max_accuracy,label = round(max_accuracy,digits=1),vjust=-1),color="red")+ - facet_wrap(~wireless+wakeupfor) - scale_x_continuous(breaks = seq(0, max(result_summary$months), by = 1)) - ggsave(paste0("figures/months_",grp,".pdf")) + geom_line(size=1.1)+geom_point(size=3)+ + geom_point(data=data%>%drop_na(mean_f1_baseline),aes(months,mean_f1_baseline,color="baseline"))+geom_line(data=data%>%drop_na(mean_f1_baseline),aes(months,mean_f1_baseline,color="baseline"))+ + geom_point(data=data%>%drop_na(mean_f1_extended),aes(months,mean_f1_extended,color="extended"))+geom_line(data=data%>%drop_na(mean_f1_extended),aes(months,mean_f1_extended,color="extended"))+ + geom_point(data=data%>%drop_na(mean_f1_hintandextended),aes(months,mean_f1_hintandextended,color="hintandextended"))+geom_line(data=data%>%drop_na(mean_f1_hintandextended),aes(months,mean_f1_hintandextended,color="hintandextended")) + + if(any(!is.na(data$mean_f1_hint))){ + plot=plot+geom_point(data=data%>%drop_na(mean_f1_hint),aes(months,mean_f1_hint,color="hint"))+geom_line(data=data%>%drop_na(mean_f1_hint),aes(months,mean_f1_hint,color="hint")) + } + + plot=plot+xlab("Number of training months")+ylab(paste("Mean",grp,"accuracy"))+ggtitle(paste(grp,"accuracy"))+ +# geom_hline(data=metrics_peak%>%filter(model==grp),aes(yintercept=max_accuracy),color="red",size=1)+ +# geom_text(data=metrics_peak%>%filter(model==grp),x=0,aes(y=max_accuracy,label = round(max_accuracy,digits=1),vjust=-1),color="red")+ + facet_wrap(~wireless+wakeupfor)+scale_x_continuous(breaks = seq(0, max(result_summary$months), by = 1))+ylim(c(0,1))+labs(color="F1 Score") + ggsave(paste0("figures/months_",grp,".pdf"),width=20,height=15) + print(plot) }) |