diff --git a/NAMESPACE b/NAMESPACE index 20c7363..d70d70e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,227 +1,224 @@ #exportPattern("^[[:alpha:]]+") export( "aggregate.bootstrap", "aggregate.bootstrap.list", "aggregate.challenge", "aggregate.ranked", "aggregate.ranked.list", "aggregateList", #? "aggregateThenRank", "as.challenge", "as.relation.challenge.incidence", "as.relation.ranked.list", "bootstrap", "bootstrap.ranked", "bootstrap.ranked.list", #"bootstrap.default", "boxplot.ranked.list", "boxplot.bootstrap.list", "boxplot.comparedRanks.list", #"check_strict_preference", "compareRanks", "compareRanks.ranked", "compareRanks.ranked.list", # "compareRanks.default", "consensus", "consensus.ranked.list", #"consensus.default", "Decision", "decision.challenge", "blobplot","blobplot.ranked", "default_colors", "density.bootstrap.list", "extract.workflow", "kendall", "kendall.bootstrap.list", # "melt.aggregated.list", "melt.ranked", "melt.ranked.list", # "merge.list", "lineplot.challenge", "methodsplot","methodsplot.challenge","methodsplot.ranked", "network", "plot.network", "podium", "podium.ranked","podium.ranked.list", "podium.challenge",#"podium.default", "print.aggregated", "print.aggregated.list", "print.comparedRanks", "print.ranked", "print.ranked.list", #"quickmerge.list", "rank", "rank.aggregated", "rank.aggregated.list", "rank.aggregatedRanks", "rank.aggregatedRanks.list", "rank.challenge", #"rank.default", "rankFrequencies", "rankFrequencies.bootstrap", "rankFrequencies.bootstrap.list", #"rankFrequencies.default", #"rankNA2", "rankThenAggregate", "rankingHeatmap", "rankingHeatmap.ranked.list", "relation_dissimilarity.ranked.list", "report", "report.bootstrap.list", "second", "select.if", "select.if.aggregated.list", "select.if.comparedRanks.list", "select.if.list", "select.if.ranked.list", "significanceMap", "spearmansFootrule", "spearmansWeightedFootrule", "splitby", "stability", "stabilityByAlgorithm", "stabilityByAlgorithmStacked","stabilityByTask", "stability.ranked.list", "stability.bootstrap","relation_dissimilarity", "stabilityByAlgorithm.bootstrap.list", "stabilityByAlgorithmStacked.bootstrap.list", "stabilityByTask.bootstrap.list", "subset.aggregated.list", "subset.comparedRanks.list", "subset.list", "subset.ranked.list", "subset.bootstrap.list", "subset.ranked","subset.bootstrap",#"which.top", "test", "test.challenge", "test.default", "testThenRank", "violin", "violin.bootstrap.list","violin.bootstrap", "winner", "winner.bootstrap", "winner.bootstrap.list", "winner.default", "winner.ranked", "winner.ranked.list", "winnerFrequencies", "winnerFrequencies.bootstrap", "winnerFrequencies.bootstrap.list", "winnerFrequencies.default" ) importFrom("dplyr", "bind_rows","group_by","summarise","select_if","filter","mutate","right_join","anti_join","ungroup","arrange","desc") importFrom("rlang",":=",".data","!!") importFrom("reshape2","melt", "acast") importFrom("utils", "capture.output", "methods") importFrom("plyr", "llply") importFrom("knitr", "kable") importFrom("tidyr", "complete","expand") importFrom("purrr", "%>%") importFrom("rmarkdown", "render","word_document","pdf_document","html_document") importFrom("viridisLite", "viridis","cividis") importFrom("ggplot2", "aes","aes_string","geom_abline", "geom_bar", "geom_boxplot", "geom_count", "geom_density", "geom_jitter", "geom_line", "geom_point", "geom_raster", "geom_step", "geom_text", "geom_violin","annotate","guide_legend", "geom_vline", "ggplot", "ggtitle","vars","xlab","ylab","scale_size_area","theme_get","rel","geom_hline","ggplot_build","scale_fill_manual", "scale_y_continuous","coord_cartesian", "element_text", "facet_wrap", "position_jitter", "stat", "stat_summary", "theme", "unit","guides","scale_fill_viridis_c") importFrom("grDevices", "col2rgb", "gray", "rgb", "grey") importFrom("graphics", "abline", "axis", "barplot", "box", "layout", "legend", "par", "plot", "points", "segments","boxplot", "stripchart", "title", "grconvertX", "plot.new") importFrom("stats", "as.dist", "as.formula", "median", "p.adjust", "density", "quantile", "aggregate", "cor", "wilcox.test", "terms.formula", "complete.cases") importFrom("methods", "new") importFrom("relations","relation","as.relation", "relation_domain", "relation_incidence", "relation_is_asymmetric","relation_consensus","relation_ensemble", "relation_is_irreflexive", "relation_is_negatively_transitive", "relation_is_transitive", "relation_is_trichotomous", "relation_scores", "relation_violations","relation_dissimilarity") importFrom("graph", "addEdge") S3method(print, comparedRanks) S3method(print, aggregated) S3method(print, ranked) S3method(print, aggregated.list) S3method(print, ranked.list) S3method(aggregate, challenge) S3method(aggregate, ranked) S3method(aggregate, ranked.list) S3method(aggregate, bootstrap.list) S3method(aggregate, bootstrap) S3method(test, default) S3method(test, challenge) S3method(Aggregate, default) S3method(Aggregate, data.frame) S3method(Aggregate, list) S3method(Rank, default) S3method(Rank, data.frame) S3method(Rank, list) S3method(rank, default) S3method(rank, challenge) S3method(rank, aggregated) S3method(rank, aggregated.list) S3method(rank, aggregatedRanks) S3method(rank, aggregatedRanks.list) S3method(blobplot, default) S3method(blobplot, ranked) S3method(bootstrap, default) S3method(bootstrap, ranked) S3method(bootstrap, ranked.list) S3method(winner, default) S3method(winner, ranked) S3method(winner, ranked.list) S3method(winner, bootstrap) S3method(winner, bootstrap.list) S3method(rankFrequencies, default) S3method(rankFrequencies, bootstrap) S3method(rankFrequencies, bootstrap.list) S3method(winnerFrequencies, default) S3method(winnerFrequencies, bootstrap) S3method(winnerFrequencies, bootstrap.list) S3method(compareRanks,default) S3method(compareRanks,ranked) S3method(compareRanks,ranked.list) S3method(merge,list) S3method(melt,ranked.list) S3method(melt,ranked) S3method(melt,aggregated.list) S3method(boxplot,ranked.list) S3method(boxplot,comparedRanks.list) S3method(boxplot,bootstrap.list) S3method(select.if,default) S3method(select.if,list) S3method(select.if,aggregated.list) S3method(select.if,ranked.list) S3method(select.if,comparedRanks.list) S3method(subset,list) S3method(subset,bootstrap.list) S3method(subset,aggregated.list) S3method(subset,ranked.list) S3method(subset,comparedRanks.list) S3method(subset,ranked) S3method(subset,bootstrap) S3method(podium,default) S3method(podium,challenge) S3method(podium,ranked) S3method(podium,ranked.list) S3method(network,default) S3method(network,ranked.list) S3method(network,dist) S3method(plot,network) S3method(density,bootstrap.list) S3method(as.relation,challenge.incidence) S3method(as.relation,ranked.list) S3method(subset,bootstrap.list) S3method(subset,ranked.list) S3method(subset,list) S3method(subset,comparedRanks.list) S3method(subset,aggregated.list) S3method(decision,challenge) S3method(decision,default) S3method(lineplot,challenge) S3method(lineplot,default) S3method(methodsplot,challenge) S3method(methodsplot,ranked) S3method(methodsplot,default) S3method(significanceMap,data.frame) -S3method(significanceMap,ranked) S3method(significanceMap,ranked.list) S3method(significanceMap,default) - - S3method(violin,bootstrap.list) S3method(violin,bootstrap) S3method(violin,default) S3method(rankingHeatmap,ranked.list) S3method(rankingHeatmap,default) S3method(relation_dissimilarity,ranked.list) S3method(relation_dissimilarity,default) S3method(stabilityByTask,bootstrap.list) S3method(stabilityByTask,default) S3method(stability,bootstrap) S3method(stability,default) S3method(stability,ranked.list) S3method(stabilityByAlgorithm,bootstrap.list) S3method(stabilityByAlgorithm,default) S3method(stabilityByAlgorithmStacked,bootstrap.list) S3method(stabilityByAlgorithmStacked,default) S3method(consensus,ranked.list) S3method(consensus,default) S3method(report,bootstrap.list) S3method(report,ranked.list) S3method(report,default) diff --git a/R/significancePlot.R b/R/significancePlot.R index 5f34d70..adc892b 100644 --- a/R/significancePlot.R +++ b/R/significancePlot.R @@ -1,169 +1,145 @@ significanceMap <- function(object,...) UseMethod("significanceMap") significanceMap.default <- function(object, ...) stop("not implemented for this class") - -significanceMap.ranked=function(object, - alpha=0.05,p.adjust.method="holm", - order=FALSE, - size.rank=.3*theme_get()$text$size,...){ - - relensemble= object$data%>%decision.challenge(na.treat=object$call[[1]][[1]]$na.treat, - alpha=alpha, - p.adjust.method=p.adjust.method - ) %>% as.relation - - significanceMap(object=object$mat, - relation_object=relensemble, - order=order, - size.rank=size.rank,... - ) - -} - - - significanceMap.ranked.list=function(object, alpha=0.05,p.adjust.method="holm", order=FALSE, size.rank=.3*theme_get()$text$size,...){ - + a=object$data%>%decision.challenge(na.treat=object$call[[1]][[1]]$na.treat, alpha=alpha, p.adjust.method=p.adjust.method) - + aa=lapply(a, as.relation.challenge.incidence) names(aa)=names(object$data) - + relensemble= do.call(relation_ensemble,args = aa) - + res=list() - for (Task in names(object$data)){ - res[[Task]]=significanceMap.data.frame(object=object$matlist[[Task]], - relation_object=relensemble[[Task]], + for (task in names(object$data)){ + res[[task]]=significanceMap.data.frame(object=object$matlist[[task]], + relation_object=relensemble[[task]], order=order, size.rank=size.rank,... - ) + ggtitle(Task) - + ) + ggtitle(task) + + } # Remove title for single-task data set if (length(res) == 1) { res[[1]]$labels$title <- NULL } res } - significanceMap.data.frame=function(object, relation_object, order=FALSE, size.rank=.3*theme_get()$text$size,...){ object$algorithm=rownames(object) inc=relation_incidence(relation_object) - + if (order){ scores=apply(inc,1, function(x) sum(x==0)-1) scores2=apply(inc,2, function(x) sum(x==1))[names(scores)]#+1-nrow(inc)) scores=data.frame(algorithm=names(scores), score=scores, score2=scores2, stringsAsFactors =F) scores=right_join(scores, object, by="algorithm") - + ordering= (scores[order(scores$score, scores$score2, scores$rank),"algorithm"]) scores=scores[,1:3] } else ordering= names(sort(t(object[,"rank",drop=F])["rank",])) - + inc=inc[ordering,] - + incidence.mat=melt(inc) colnames(incidence.mat)=c("algorithm","notsigPair", "decision") incidence.mat$algorithm=as.character(incidence.mat$algorithm) incidence.mat$notsigPair=as.character(incidence.mat$notsigPair) incidence.mat=right_join(incidence.mat, object, by="algorithm") if (order) incidence.mat=right_join(incidence.mat, scores, by="algorithm") - - incidence.mat=incidence.mat%>%mutate(algorithm=factor(.data$algorithm, + + incidence.mat=incidence.mat%>%mutate(algorithm=factor(.data$algorithm, levels=ordering), - notsigPair=factor(.data$notsigPair, + notsigPair=factor(.data$notsigPair, levels=ordering)) - + incidence.mat$decision=as.factor(incidence.mat$decision) p=ggplot(incidence.mat) + geom_raster(aes(algorithm, notsigPair, fill=decision),...)+ geom_raster(aes(algorithm,algorithm), fill="white")+ - geom_abline(slope=1) + + geom_abline(slope=1) + coord_cartesian(clip = 'off')+ theme(aspect.ratio=1, axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1), plot.margin=unit(c(1,1,1,1), "lines"), legend.position="none")+ ylab("Algorithm")+ xlab("Algorithm")+ scale_fill_manual(values=cividis(2,begin=0,end=1,alpha=.7)) - - fixy=0 th_get=theme_get() - # grid on top + # grid on top lt=th_get$panel.grid$linetype if (is.null(lt)) lt=th_get$line$linetype #p=p+theme(panel.background = element_rect(fill = NA),panel.ontop=TRUE) #-> grid will be on top of diagonal #fix: f=ggplot_build(p) - p= p + geom_vline(xintercept=f$layout$panel_params[[1]]$x.major_source, + p= p + geom_vline(xintercept=f$layout$panel_params[[1]]$x.major_source, linetype=lt, - color=th_get$panel.grid$colour, + color=th_get$panel.grid$colour, size=rel(th_get$panel.grid.major$size))+ - geom_hline(yintercept=f$layout$panel_params[[1]]$y.major_source, + geom_hline(yintercept=f$layout$panel_params[[1]]$y.major_source, linetype=lt, - color=th_get$panel.grid$colour, + color=th_get$panel.grid$colour, size=rel(th_get$panel.grid.major$size))+ geom_abline(slope=1)+ geom_text(aes(x=algorithm,y=fixy,label=rank), - nudge_y=.5, + nudge_y=.5, vjust = 0, size=size.rank, fontface="plain",family="sans" ) - + if (order) p= p+ geom_text(aes(x=algorithm,y=fixy,label=score), - nudge_y=0, + nudge_y=0, vjust = 0, size=size.rank, - fontface="plain",family="sans") + + fontface="plain",family="sans") + annotate("text", - x=0,y=fixy+.5, - vjust = 0, - size=size.rank, + x=0,y=fixy+.5, + vjust = 0, + size=size.rank, fontface="plain", family="sans", label="original")+ - annotate("text",x=0,y=fixy, - vjust = 0, + annotate("text",x=0,y=fixy, + vjust = 0, size=size.rank, fontface="plain",family="sans",label="new") - + return(p) } -