diff --git a/NAMESPACE b/NAMESPACE index 20d3633..fda212d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,223 +1,209 @@ #exportPattern("^[[:alpha:]]+") export( - "aggregate.bootstrap", "aggregate.bootstrap.list", "aggregate.challenge", "aggregate.ranked", "aggregate.ranked.list", - "aggregateList", #? + "aggregate.bootstrap", "aggregate.bootstrap.list", "aggregate.challenge", "aggregate.ranked.list", "aggregateThenRank", "as.challenge", "as.relation.challenge.incidence", "as.relation.ranked.list", - "bootstrap", "bootstrap.ranked", "bootstrap.ranked.list", #"bootstrap.default", + "bootstrap", "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", "network", "plot.network", - "podium", "podium.ranked","podium.ranked.list", "podium.challenge",#"podium.default", + "podium","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", + "rank", "rank.aggregated.list", "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", + "stability.ranked.list", "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", #"which.top", "taskSubset.ranked.list", "taskSubset.bootstrap.list", "test", "test.challenge", "test.default", "testThenRank", "violin", "violin.bootstrap.list", "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(taskSubset,ranked.list) S3method(taskSubset,bootstrap.list) 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,default) S3method(significanceMap,data.frame) S3method(significanceMap,ranked.list) S3method(significanceMap,default) S3method(violin,bootstrap.list) 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/AggregateList.R b/R/AggregateList.R deleted file mode 100644 index 244be3d..0000000 --- a/R/AggregateList.R +++ /dev/null @@ -1,22 +0,0 @@ - -# FUNname=capture.output(get_expr(FUN))[2] -# FUNname=sub("UseMethod(","",FUNname,fixed = T) - -# depracate? -aggregateList=function(object, - x, - FUN=mean){ - if (is.character(FUN)) { - FUNname=paste0(x,"_",FUN) - FUN=try(eval(parse(text=FUN)),silent = T) - } else FUNname=paste0(x,"_aggregated") - - melt(object)%>% - filter(variable==x)%>% - group_by(algorithm)%>% - summarise(!!FUNname := FUN(value))%>% - as.data.frame -} - - - diff --git a/R/Bootstrap.R b/R/Bootstrap.R index 21b7736..549c7c4 100644 --- a/R/Bootstrap.R +++ b/R/Bootstrap.R @@ -1,251 +1,179 @@ bootstrap <- function(object,...) UseMethod("bootstrap") bootstrap.default <- function(object, ...) stop("not implemented for this class") -bootstrap.ranked=function(object, - nboot, - parallel=FALSE, - progress="text",...){ - data=object$data - algorithm=attr(data,"algorithm") - by=attr(data,"case") - index=unique(data[[by]]) - # stop if only 1 data set or less than 3 algorithms - if (length(index)==1 | length(unique(data[[algorithm]]))<=2 ) stop("There need to be at least 2 unique values in ", - by, - "and at least 3 unique in ", - algorithm) - - drawsample=function(piece,...){ - bootIndex=data.frame(sample(index, - size=length(index), - replace=TRUE)) - colnames(bootIndex)=by - bootData=merge(bootIndex,data,by=by) - # bootIndex=sample(index,size=length(index),replace=TRUE) - # bootData=bind_rows(lapply(bootIndex,function(zz) data[data[[by]]==zz,])) - #3rd alternative (untested) - # bootIndex=sample(index,size=length(index),replace=TRUE) - #bootData=bind_rows(split(data,data[[by]])[bootIndex])) - attr(bootData,"inverseOrder")=attr(object$data,"inverseOrder") - attr(bootData,"algorithm")=attr(object$data,"algorithm") - attr(bootData,"case")=attr(object$data,"case") - attr(bootData,"check")=FALSE - object$FUN(bootData)$mat - } - res=llply(.data=1:nboot, - .fun =drawsample , - .parallel=parallel, - .progress=progress) - - rankmat=res[[1]][,-1,drop=F] - for (j in 2:length(res)){ - rankmat=merge(rankmat, - res[[j]][,-1,drop=F], - by="row.names", - suffixes = c(paste0(".",j-1), - paste0(".",j))) #maybe replayce by plyr::join() which is supposed to be faster - rownames(rankmat)=rankmat[,"Row.names"] - rankmat=rankmat[,-1] - } - aggmat=res[[1]][,-2,drop=F] - for (j in 2:length(res)){ - aggmat=merge(aggmat, - res[[j]][,-2,drop=F], - by="row.names", - suffixes = c(paste0(".",j-1), - paste0(".",j))) - rownames(aggmat)=aggmat[,"Row.names"] - aggmat=aggmat[,-1] - } - - res=list(bootsrappedRanks=rankmat, - bootsrappedAggregate=aggmat, - data=data, - mat=object$mat, - FUN=object$FUN, - FUN.list=object$FUN.list) - class(res)="bootstrap" - res -} - - - bootstrap.ranked.list=function(object, nboot, parallel=FALSE, progress="text", ...){ algorithm=attr(object$data,"algorithm") by=attr(object$data,"case") - + # exclude if only 1 data set or less than 3 algorithms - tidy.data.id=sapply(object$data, + tidy.data.id=sapply(object$data, function(data.subset) { ifelse((length(unique(data.subset[[by]]))==1 | length(unique(data.subset[[algorithm]]))<=2 ), yes=FALSE, no=TRUE) }) tidy.data=object$data[tidy.data.id] tidy.matlist=object$matlist[tidy.data.id] - - res= llply(1:nboot, + + res= llply(1:nboot, function(it){ # draw 1 sample for each task bootDatalist = lapply(tidy.data, function(data.subset) { index = unique(data.subset[[by]]) - + # bootIndex=sample(index,size=length(index),replace=TRUE) # bootData=bind_rows(lapply(bootIndex,function(zz) data.subset[data.subset[[by]]==zz,])) # faster: - bootIndex = data.frame(sample(index, - size = length(index), + bootIndex = data.frame(sample(index, + size = length(index), replace = TRUE)) colnames(bootIndex) = by - bootData = merge(bootIndex, - data.subset, + bootData = merge(bootIndex, + data.subset, by = by) bootData }) attr(bootDatalist, "inverseOrder") = attr(object$data, "inverseOrder") attr(bootDatalist, "algorithm") = attr(object$data, "algorithm") attr(bootDatalist, "case") = attr(object$data, "case") attr(bootDatalist, "check") = FALSE object$FUN(bootDatalist)$mat - }, - .parallel = parallel, + }, + .parallel = parallel, .progress = progress) - - + + # rankmatlist=lapply(res[[1]],function(z) z[,"rank",drop=F]) # for (j in 2:length(res)){ # rankmatlist=merge.list(rankmatlist,lapply(res[[j]],function(z) z[,"rank",drop=F]),by="row.names", suffixes = c(paste0(".",j-1),paste0(".",j))) # rankmatlist=lapply(rankmatlist, function(z) { # rownames(z)=z[,"Row.names"] # z=z[,-1] # }) # } - # + # # aggmatlist=lapply(res[[1]],function(z) z[,-2,drop=F]) # for (j in 2:length(res)){ # aggmatlist=merge.list(aggmatlist,lapply(res[[j]],function(z) z[,-2,drop=F]),by="row.names", suffixes = c(paste0(".",j-1),paste0(".",j))) # aggmatlist=lapply(aggmatlist, function(z) { # rownames(z)=z[,"Row.names"] # z=z[,-1] # }) # } rankmatlist = lapply(res[[1]], function(z) z[, "rank", drop = F] ) for (j in 2:length(res)) { - rankmatlist = quickmerge.list(rankmatlist, - lapply(res[[j]], + rankmatlist = quickmerge.list(rankmatlist, + lapply(res[[j]], function(z) z[, "rank", drop = F])) } - - aggmatlist = lapply(res[[1]], + + aggmatlist = lapply(res[[1]], function(z) z[, -2, drop = F]) for (j in 2:length(res)) { - aggmatlist = quickmerge.list(aggmatlist, - lapply(res[[j]], + aggmatlist = quickmerge.list(aggmatlist, + lapply(res[[j]], function(z) z[, -2, drop = F])) } - + final=list(bootsrappedRanks=rankmatlist, - bootsrappedAggregate=aggmatlist, + bootsrappedAggregate=aggmatlist, data=object$data, matlist=tidy.matlist, FUN=object$FUN, FUN.list=object$FUN.list) class(final)=c("bootstrap.list") final } #################################################################################################### # deprecate following functions? rankFrequencies <- function(object,...) UseMethod("rankFrequencies") rankFrequencies.default <- function(object, ...) stop("not implemented for this class") rankFrequencies.bootstrap=function(object, who,...){ if (is.data.frame(who)) who=rownames(who) if (length(who)==1){ res=table(t(object$bootsrappedRanks[rownames(object$bootsrappedRanks)==who,])) cat("\n",who,"\n") print(res) } else { res=lapply(who, function(w){ rr=table(t(object$bootsrappedRanks[rownames(object$bootsrappedRanks)==w,])) cat(w,"\n") print(rr) cat("\n") rr }) } res=c(list(rankFrequencies=res),object) invisible(res) } rankFrequencies.bootstrap.list=function(object, who,...){ if (is.data.frame(who)) who=rownames(who) res=lapply(object$bootsrappedRanks,function(bootMat){ if (length(who)==1){ res=table(t(bootMat[rownames(bootMat)==who,])) cat("\n",who,"\n") print(res) } else { res=lapply(who, function(w){ rr=table(t(bootMat[rownames(bootMat)==w,])) cat(w,"\n") print(rr) cat("\n") rr }) } res }) res=c(list(rankFrequencies=res),object) invisible(res) } winnerFrequencies <- function(object,...) UseMethod("winnerFrequencies") winnerFrequencies.default <- function(object, ...) stop("not implemented for this class") # Achtung: bester rank muss ==1 sein und nicht z.B. 1.5 winnerFrequencies.bootstrap=function(object,...){ rankings_dicho=ifelse(object$bootsrappedRanks==1,1,0) winnerFrequencies=data.frame(winnerFrequency=rowSums(rankings_dicho),row.names = rownames(object$bootsrappedRanks)) res=merge(object$mat,winnerFrequencies,by="row.names",...) rownames(res)=res[,1] res=res[,-1] # res=c(res=res,object) # class(res)="bootstrapResults" res } winnerFrequencies.bootstrap.list=function(object,...){ res=lapply(1:length(object$bootsrappedRanks),function(id){ rankings_dicho=ifelse(object$bootsrappedRanks[[id]]==1,1,0) winnerFrequencies=data.frame(winnerFrequency=rowSums(rankings_dicho),row.names = rownames(object$bootsrappedRanks[[id]])) res=merge(object$matlist[[id]],winnerFrequencies,by="row.names",...) rownames(res)=res[,1] res=res[,-1] res }) names(res)=names(object$bootsrappedRanks) res } - - - diff --git a/R/Rank.R b/R/Rank.R index 3bb24fb..d7119eb 100644 --- a/R/Rank.R +++ b/R/Rank.R @@ -1,134 +1,74 @@ Rank <- function(object,...) UseMethod("Rank") Rank.default <- function(object, ...) rank(object,...) #base::rank -Rank.data.frame <-function(object, - x, - annotator, - ties.method="min", - largeBetter=FALSE, - ...){ - call=match.call(expand.dots = T) - if (attr(object,"check") && - largeBetter && - any(is.na(object[[x]])) && - min(object[[x]],na.rm=TRUE)==0){ - message("There are missing metric values and metric values exactly equal to zero. - Have some actually missing values been entered as zero in some instances? - If yes, specify optional argument na.treat=0 in as.challenge().") - } - if (missing(annotator)){ - res=bind_rows(lapply(split(object, - object[[attr(object,"case")]]), - function(object.case) - cbind(object.case, - rank=rankNA2(object.case[[x]], - ties.method = ties.method, - largeBetter = largeBetter) - ) - ) - ) - } else { - if (length(annotator)==1) annotator=object[,annotator] - else annotator=as.list(object[,annotator]) - byAnnotator=split(object,annotator) - res=bind_rows(lapply(byAnnotator, - function(annotator.i){ - bind_rows(lapply(split(annotator.i, - annotator.i[[attr(object,"case")]]), - function(annotator.case) - cbind(annotator.case, - rank=rankNA2(annotator.case[[x]], - ties.method = ties.method, - largeBetter = largeBetter) - ) - ) - ) - } - )) - - } - - res=list(FUN = . %>% (call), - call=list(call), - data=object, - mat=res) - class(res)=c("ranked",class(res)) - - res -} - - - Rank.list <- function(object, x, annotator, ties.method="min", largeBetter=FALSE, ...){ - - call=match.call(expand.dots = T) + + call=match.call(expand.dots = T) annotator.missing=missing(annotator) - if (any(sapply(object, + if (any(sapply(object, function(task) { - (attr(object,"check") && - largeBetter && - any(is.na(task[[x]])) && + (attr(object,"check") && + largeBetter && + any(is.na(task[[x]])) && min(task[[x]], na.rm=TRUE)==0) }) )) { - message("There are missing metric values and metric values exactly equal to zero. + message("There are missing metric values and metric values exactly equal to zero. Have some actually missing values been entered as zero in some instances? If yes, specify optional argument na.treat=0 in as.challenge().") } - - matlist=lapply(object, + + matlist=lapply(object, function(task){ if (annotator.missing){ res=bind_rows( lapply(split(task, task[[attr(object,"case")]]), - function(task.case) + function(task.case) cbind(task.case, rank=rankNA2(task.case[[x]], ties.method = ties.method, largeBetter = largeBetter) ) ) ) class(res)[2]="ranked" res } else { byAnnotator=split(task, - as.list(task[,annotator])) + as.list(task[,annotator])) temp=bind_rows( lapply(byAnnotator, function(annotator){ bind_rows( lapply(split(annotator, annotator[[attr(object,"case")]]), - function(annotator.case) + function(annotator.case) cbind(annotator.case, rank=rankNA2(annotator.case[[x]], ties.method = ties.method, largeBetter = largeBetter) ) ) ) } ) ) class(temp)[2]="ranked" temp } - } + } ) res=list(FUN = . %>% (call), call=list(call), data=object, matlist=matlist) - + class(res)=c("ranked.list",class(res)) res - } - - +} diff --git a/R/Rank.aggregated.R b/R/Rank.aggregated.R deleted file mode 100644 index 5a1d473..0000000 --- a/R/Rank.aggregated.R +++ /dev/null @@ -1,61 +0,0 @@ - -rank.aggregated <-function(object, - ties.method="min", - largeBetter, - ...){ - call=match.call(expand.dots = F) - if (missing(largeBetter)){ - if (!is.null(attr(object$data,"largeBetter"))) largeBetter=attr(object$data,"largeBetter") - else stop("largeBetter has to be provided either in as.challenge() or rank()") - - if (object$isSignificance) largeBetter=TRUE # smallBetter (largeBetter) already taken care of by one-sided test nature of signficance - } - call=call("rank.aggregated", - object=call$object, - ties.method=ties.method, - largeBetter=largeBetter) - mat=object$mat - - if (nrow(mat)>0) r=rankNA2(mat[,ncol(mat)], - ties.method=ties.method, - largeBetter=largeBetter) - else r=NULL - - res=list(mat=cbind(mat,rank=r), - data=object$data, - call=list(object$call,call), - FUN = . %>% (object$FUN) %>% (call), - FUN.list=c(object$FUN.list,"rank") - ) - class(res)=c("ranked",class(res)) - res -} - - - -rank.aggregatedRanks <-function(object, - ties.method="min", - ...){ - call=match.call(expand.dots = F) - call=call("rank.aggregatedRanks", - object=call$object, - ties.method=ties.method) - mat=object$mat - - if (nrow(mat)>0) r=rankNA2(mat[,ncol(mat)], - ties.method=ties.method, - largeBetter=FALSE) - else r=NULL - - res=list(mat=cbind(mat,rank=r), - data=object$data, - call=list(object$call,call), - FUN = . %>% (object$FUN) %>% (call), - FUN.list=c(object$FUN.list,"rank") - ) - class(res)=c("ranked",class(res)) - res -} - - - diff --git a/R/aaggregate.R b/R/aaggregate.R index 72da78b..223af22 100644 --- a/R/aaggregate.R +++ b/R/aaggregate.R @@ -1,202 +1,166 @@ test <- function(x,...) UseMethod("test") test.default <- function(x, ...) stop("not implemented for this class") test.challenge=function(x,...) aggregate.challenge(x=x, FUN="significance",...) #' Title #' -#' @param x -#' @param FUN -#' @param na.treat -#' @param alpha -#' @param p.adjust.method -#' @param parallel -#' @param progress -#' @param ... +#' @param x +#' @param FUN +#' @param na.treat +#' @param alpha +#' @param p.adjust.method +#' @param parallel +#' @param progress +#' @param ... #' #' @return #' @export #' #' @examples aggregate.challenge=function(x, FUN=mean, na.treat, #either "na.rm", numeric value or function - alpha=0.05, p.adjust.method="none",# only needed for significance + alpha=0.05, p.adjust.method="none",# only needed for significance parallel=FALSE, progress="none",...){ call=as.list(match.call()) - + if (missing(na.treat)){ #na.treat only optional if no missing values in data set if (!inherits(x,"list")){ if (!any(is.na(x[,attr(x, "value")]))) na.treat="na.rm" # there are no missings so set na.treat by dummy "na.rm" has no effect } else { - if (!any(sapply(x, + if (!any(sapply(x, function(task) any(is.na(task[,attr(x, "value")]))))) na.treat="na.rm" # there are no missings so set na.treat by dummy "na.rm" has no effect } } - + res1=do.call("Aggregate",list(object=x, x=attr(x,"value"), algorithm=attr(x,"algorithm"), FUN=call$FUN, na.treat=na.treat, parallel=parallel, progress=progress, case=attr(x,"case"), alpha=alpha, p.adjust.method=p.adjust.method, largeBetter=attr(x,"largeBetter") # only needed for significance )) - + call2=call("Aggregate", - object=call$x, + object=call$x, x=attr(x,"value"), algorithm=attr(x,"algorithm"), FUN=call$FUN, na.treat=na.treat, parallel=parallel,progress=progress, - case=attr(x,"case"), - alpha=alpha, p.adjust.method=p.adjust.method, - largeBetter=attr(x,"largeBetter") # only needed for significance + case=attr(x,"case"), + alpha=alpha, p.adjust.method=p.adjust.method, + largeBetter=attr(x,"largeBetter") # only needed for significance ) - if (inherits(x,"list")){ + if (inherits(x,"list")){ res=list(FUN = . %>% (call2), call=list(call2), FUN.list=list(FUN), data=x, matlist=res1$matlist, isSignificance=res1$isSignificance) - + class(res)=c("aggregated.list",class(res)) } else { res=list(FUN = . %>% (call2), call=list(call2), FUN.list=list(FUN), data=x, mat=res1$mat, isSignificance=res1$isSignificance) - - class(res)=c("aggregated",class(res)) - - } - res - -} + class(res)=c("aggregated",class(res)) -aggregate.ranked <-function(x, - FUN=mean, ... ){ - call=match.call(expand.dots = F) - call=call("aggregate.ranked", - x=call$x, - FUN=FUN) - algorithm=attr(x$data,"algorithm") - mat=x$mat - what="rank" - xmean <- aggregate(mat[,what], - by=list(mat[,algorithm]), - FUN=function(z) do.call(FUN,args=list(x=z))) - names(xmean)=c(algorithm,paste0(what, - "_", - strsplit(capture.output(suppressWarnings(print(methods(FUN), - byclass=T)))[1], - " ")[[1]][2] - ) - ) - rownames(xmean)=xmean[,1] - xmean=xmean[,-1,drop=F] - res=list(FUN = . %>% (x$FUN) %>% (call), - FUN.list=c(x$FUN.list,FUN), - call=c(x$call,call), - data=x$data, - mat=xmean) - class(res)=c("aggregatedRanks",class(res)) + } res -} +} aggregate.ranked.list <-function(x, - FUN=mean, + FUN=mean, ...){ - call=match.call(expand.dots = F) + call=match.call(expand.dots = F) call=call("aggregate.ranked.list", x=call$x, FUN=FUN) - + algorithm=attr(x$data,"algorithm") resmatlist=Aggregate.list(x$matlist, x="rank", algorithm=algorithm, FUN=FUN,...)$matlist resmatlist=lapply(resmatlist, function(z) as.data.frame(z)) res=list(matlist=resmatlist, call=c(x$call,call), data=x$data, FUN = . %>% (x$FUN) %>% (call), FUN.list=c(x$FUN.list,FUN) ) class(res)=c("aggregatedRanks.list",class(res)) res - -} - - +} aggregate.bootstrap.list <-function(x, what="metric", FUN=mean, ...){ - call=match.call(expand.dots = T) + call=match.call(expand.dots = T) if (is.character(FUN)) FUN=try(eval(parse(text=FUN)), silent = T) FUNname=as.character(call$FUN) - + if (!is.function(FUN)) stop("FUN has to be a function (possibly as character)") - matlist=llply(1:length(x$bootsrappedRank), - function(i.piece){ + matlist=llply(1:length(x$bootsrappedRank), + function(i.piece){ if (what=="ranks") xmean <- as.data.frame(apply(x$bootsrappedRank[[i.piece]],1,FUN=FUN)) - else xmean <- as.data.frame(apply(x$bootsrappedAggregate[[i.piece]],1,FUN=FUN)) + else xmean <- as.data.frame(apply(x$bootsrappedAggregate[[i.piece]],1,FUN=FUN)) names(xmean)=paste0(what,"_",FUNname) xmean }) - - + + names(matlist)=names(x$bootsrappedRank) res=list(FUN = . %>% (call), call=list(call), data=x, matlist=matlist) - + class(res)=c("aggregated.list",class(res)) res } aggregate.bootstrap<-function(x,what="metric",FUN=mean, ... ){ - call=match.call(expand.dots = T) + call=match.call(expand.dots = T) if (is.character(FUN)) FUN=try(eval(parse(text=FUN)),silent = T) FUNname=as.character(call$FUN) - + if (!is.function(FUN)) stop("FUN has to be a function (possibly as character)") - + if (what=="ranks") xmean <- as.data.frame(apply(x$bootsrappedRank, 1, FUN=FUN)) else xmean <- as.data.frame(apply(x$bootsrappedAggregate, 1, - FUN=FUN)) + FUN=FUN)) names(xmean)=paste0(what,"_",FUNname) res=list(FUN = . %>% (call), call=list(call), data=x, mat=xmean) - + class(res)=c("aggregated",class(res)) res } - diff --git a/R/blobplot.ranked.R b/R/blobplot.ranked.R deleted file mode 100644 index 1cc5275..0000000 --- a/R/blobplot.ranked.R +++ /dev/null @@ -1,43 +0,0 @@ -blobplot <- function(x,...) UseMethod("blobplot") -blobplot.default <- function(x, ...) stop("not implemented for this class") - -blobplot.ranked=function(x, - ties.method="min", - probs=c(.025,.975), - max_size=6, - shape=4, - ...){ - ordering=rownames(x$mat)[order(x$mat$rank)] - xx=x$data - ranking=xx%>%rank( ties.method = ties.method ) - - dat=ranking$mat - algorithm=attr(xx,"algorithm") - dat[[algorithm]]=factor(dat[[algorithm]], levels=ordering) - #dat[["case"]]=as.character(dat[["case"]]) - p = ggplot(dat)+ - # geom_line(aes(x = algorithm, y = rank,color=case, group=case ),size=.2,linetype=1,show.legend = F)+ - geom_count(aes(!!as.symbol(algorithm), - rank, - color=!!as.symbol(algorithm), - size = stat(prop*100))) - - p+scale_size_area(max_size = max_size)+ - stat_summary(aes(!!as.symbol(algorithm),rank), - geom="point",shape=shape, - fun.data=function(x) data.frame(y=median(x)),...) + - stat_summary(aes(!!as.symbol(algorithm),rank ), - geom="linerange", - fun.data=function(x) data.frame(ymin=quantile(x,probs[1]), - ymax=quantile(x,probs[2])))+ - geom_abline(slope=1,color="gray",linetype="dotted")+ - theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))+ - guides(size = guide_legend(title="%"),color="none")+ - scale_y_continuous(minor_breaks=NULL, - limits=c(1,max(5,max(dat$rank))), - breaks=c(1,seq(5,max(5,max(dat$rank)),by=5)))+ - xlab("Algorithm")+ylab("Rank") -} - - - diff --git a/R/melt.R b/R/melt.R index 43b0d5b..3f0e0aa 100644 --- a/R/melt.R +++ b/R/melt.R @@ -1,13 +1,7 @@ melt.ranked.list=melt.aggregated.list=function(object,...){ matlist=lapply(object$matlist, function(z){ z$algorithm=rownames(z) z }) melt(matlist,id.vars="algorithm",...) } - -melt.ranked= - function(object,...){ - object$mat$algorithm=rownames(object$mat) - object$mat - } diff --git a/R/podium.R b/R/podium.R index 8d71468..988fd14 100644 --- a/R/podium.R +++ b/R/podium.R @@ -1,214 +1,160 @@ podium <- function(object,...) UseMethod("podium") podium.default <- function(object, ...) stop("not implemented for this class") - -podium.ranked=function(object, - xlab = NULL, - ylab = NULL, - lines.show = TRUE, - lines.alpha = 0.2, - lines.lwd = 1, - col, - lines.col = col, - dots.pch = 19, - dots.cex = 1, - places.lty = 2, - places.col = 1, - legendfn = function(algs, cols) { - legend("topleft", - algs, - lwd = 1, - col = cols, - bg = "white") - }, - layout.heights = c(1, 0.4), - ...) { - ordering=t(object$mat[,"rank",drop=F])["rank",] - if (is.null(xlab)) xlab <- "Podium" - if (is.null(ylab)) ylab <- "Performance" - if (missing(col)) col=default_colors(length(ordering), - algorithms = names(ordering)) - #dd=object$data - # dd will be same as object$data, except that na.treat is handled if aggregateThenRank - x=object$data - dd=as.challenge(x, - value=attr(x,"value"), - algorithm=attr(x,"algorithm") , - case=attr(x,"case"), - by=attr(x, "by"), - annotator = attr(x,"annotator"), - smallBetter = !attr(x,"largeBetter"), - na.treat=object$call[[1]][[1]]$na.treat) - - podium( dd, - ordering=ordering, - xlab = xlab, - ylab = ylab, - lines.show = lines.show, - lines.alpha = lines.alpha, - lines.lwd = lines.lwd, - col=col, - lines.col = lines.col, - dots.pch = dots.pch, - dots.cex = dots.cex, - places.lty = places.lty, - places.col = places.col, - legendfn = legendfn, - layout.heights=layout.heights, - ...) -} - - - podium.ranked.list=function(object, xlab = NULL, ylab = NULL, lines.show = TRUE, lines.alpha = 0.2, lines.lwd = 1, col, lines.col = col, dots.pch = 19, dots.cex = 1, places.lty = 2, places.col = 1, legendfn = function(algs, cols) { legend("topleft", algs, lwd = 1, col = cols, bg = "white") }, layout.heights=c(1,0.4), ...){ if (is.null(xlab)) xlab <- "Podium" if (is.null(ylab)) ylab <- "Performance" x=object$data + + podiumPlots <- length(names(x)) + for (subt in names(x)) { ordering=t(object$matlist[[subt]][,"rank",drop=F])["rank",] if (missing(col)) col=default_colors(length(ordering), algorithms = names(ordering)) dd=as.challenge(x[[subt]], value=attr(x,"value"), algorithm=attr(x,"algorithm"), case=attr(x,"case"), by=attr(x, "by"), annotator = attr(x,"annotator"), smallBetter = !attr(x,"largeBetter"), na.treat=object$call[[1]][[1]]$na.treat) - podium(dd, + podiumPlot <- podium(dd, ordering=ordering, xlab = xlab, ylab = ylab, lines.show = lines.show, lines.alpha = lines.alpha, lines.lwd = lines.lwd, col=col, lines.col = lines.col, dots.pch = dots.pch, dots.cex = dots.cex, places.lty = places.lty, places.col = places.col, legendfn = legendfn, layout.heights=layout.heights, ...) title(subt,outer=T,line=-3) + + append(podiumPlots, podiumPlot) } } podium.challenge=function(object, ordering, xlab = NULL, ylab = NULL, lines.show = FALSE, lines.alpha = 0.2, lines.lwd = 1, col,lines.col = col, dots.pch = 19, dots.cex = 1, places.lty = 2, places.col = 1, legendfn = function(algs, cols) { legend("topleft", algs, lwd = 1, col = cols, bg = "white") }, layout.heights=c(1,0.4), ...) { ranking=object%>%rank( ties.method = "random" ) task <- ranking$matlist[[1]] dat=as.data.frame(table(task[[attr(object, "algorithm")]], task$rank, dnn=c("algorithm","rank")), responseName = "Count") form=as.formula(paste(attr(object,"case"), attr(object,"algorithm"), sep="~")) ranks=acast(task, form, value.var="rank") values=acast(task, form, value.var=attr(object, "value")) nranks=acast(dat, algorithm~rank, value.var="Count") nalgs <- ncol(ranks) algs <- colnames(ranks) barorder <- order(ordering) orderedAlgorithms= names(ordering)[barorder] ylim=range(task[[attr(object,"value")]], na.rm = TRUE) dotplotborders <- (0:nalgs) * nalgs dotplaces <- (1:nalgs) - 0.5 names(dotplaces) <- orderedAlgorithms linecols <- sapply(lines.col, function(c) { r <- col2rgb(c) rgb(r[1], r[2], r[3], alpha = round(255 * lines.alpha), maxColorValue = 255) }) opar <- par(no.readonly = TRUE) layout(matrix(c(1, 2), nrow = 2, byrow = TRUE), heights =layout.heights) mar <- par("mar") par(mar = c(0, mar[2], mar[3], mar[4])) plot(dotplotborders, rep(ylim[2], nalgs + 1), type = "n", ylim = ylim, ylab = ylab, xlab = "", axes = F) axis(1, at = dotplotborders, labels = NA, lwd = par("lwd")) axis(2, lwd = par("lwd")) box() abline(v = dotplotborders, lty = places.lty, col = places.col) linesegments <- function(x, y, ...) { n <- length(x) segments(x[-n], y[-n], x[-1], y[-1], ...) } drawthe <- function(fn, col, ...) { for (i in 1:nrow(values)) { r <- ranks[i, ] o <- order(r) performances <- (values[i, ])[o] places <- (dotplaces[names(r)] + ((r - 1) * nalgs))[o] fn(places, performances, col = col[names(r)[o]], ...) } } if (lines.show) drawthe(linesegments, linecols, lwd = lines.lwd) drawthe(points, col, pch = dots.pch, cex = dots.cex) legendfn(orderedAlgorithms, col[orderedAlgorithms]) par(mar = c(mar[1], mar[2], 0, mar[4])) barplot(nranks[barorder,], beside = TRUE, width = 1, axes = F, space = c(0, 0), border = NA, ylim = c(0, nrow(ranks)), names.arg = paste(1:nalgs, ".", sep = ""), col = col[orderedAlgorithms], xlab = xlab) axis(1, at = c(0, dotplotborders), labels = NA, lwd = par("lwd")) box() par(opar) } diff --git a/R/rrank.R b/R/rrank.R index 34f9f59..020d373 100644 --- a/R/rrank.R +++ b/R/rrank.R @@ -1,59 +1,48 @@ rank <- function(object,...) UseMethod("rank") rank.default <- function(object, ...) base::rank(object,...) #stats::aggregate rank.challenge=function(object, x, ties.method="min",...){ call=as.list(match.call()) if (!is.null(attr(object,"annotator"))) { call2=call("Rank", - object=call$object, - x=attr(object,"value"), + object=call$object, + x=attr(object,"value"), annotator=c(attr(object,"annotator")), ties.method=ties.method, - largeBetter=attr(object,"largeBetter") + largeBetter=attr(object,"largeBetter") ) res1=do.call("Rank",list(object=object, x=attr(object,"value"), annotator=c(attr(object,"annotator")), ties.method=ties.method, - largeBetter=attr(object,"largeBetter") + largeBetter=attr(object,"largeBetter") )) - + } else { call2=call("Rank", - object=call$object, - x=attr(object,"value"), + object=call$object, + x=attr(object,"value"), ties.method=ties.method, - largeBetter=attr(object,"largeBetter") + largeBetter=attr(object,"largeBetter") ) res1=do.call("Rank",list(object=object, x=attr(object,"value"), ties.method=ties.method, - largeBetter=attr(object,"largeBetter") + largeBetter=attr(object,"largeBetter") )) - + } - - if (inherits(object,"list")){ - res=list(FUN = . %>% (call2), - call=list(call2), - FUN.list=list("rank"), - data=object, - matlist=res1$matlist) - - class(res)=c("ranked.list",class(res)) - } else { - res=list(FUN = . %>% (call2), - call=list(call2), - FUN.list=list("rank"), - data=object, - mat=res1$mat) - - class(res)=c("ranked",class(res)) - - } + + res=list(FUN = . %>% (call2), + call=list(call2), + FUN.list=list("rank"), + data=object, + matlist=res1$matlist) + + class(res)=c("ranked.list",class(res)) res } diff --git a/R/visualization.R b/R/visualization.R index 59dda60..93cf5a4 100644 --- a/R/visualization.R +++ b/R/visualization.R @@ -1,292 +1,270 @@ stability <- function(x,...) UseMethod("stability") stability.default <- function(x, ...) stop("not implemented for this class") stabilityByAlgorithm <- function(x,...) UseMethod("stabilityByAlgorithm") stabilityByAlgorithm.default <- function(x, ...) stop("not implemented for this class") stabilityByAlgorithmStacked <- function(x,...) UseMethod("stabilityByAlgorithmStacked") stabilityByAlgorithmStacked.default <- function(x, ...) stop("not implemented for this class") stabilityByTask <- function(x,...) UseMethod("stabilityByTask") stabilityByTask.default <- function(x, ...) stop("not implemented for this class") stability.ranked.list=function(x, ordering, probs=c(.025,.975), max_size=6, freq=FALSE, shape=4,...) { if (length(x$data) < 2) { stop("The stability of rankings across tasks cannot be computed for less than two tasks.") } dd=melt(x, measure.vars="rank", value.name="rank") %>% dplyr::rename(task="L1") if (!missing(ordering)) { dd=dd%>%mutate(algorithm=factor(.data$algorithm, levels=ordering)) } else dd=dd%>%mutate(algorithm=factor(.data$algorithm)) if (!freq) { p = ggplot(dd)+ geom_count(aes(algorithm , rank, color=algorithm , size = stat(prop*100))) } else { p=ggplot(dd)+ geom_count(aes(algorithm, rank ,color=algorithm )) } p+scale_size_area(max_size = max_size)+ stat_summary(aes(algorithm ,rank ), geom="point", shape=shape, fun.data=function(x) data.frame(y=median(x)),...)+ stat_summary(aes(algorithm ,rank ), geom="linerange", fun.data=function(x) data.frame(ymin=quantile(x,probs[1]), ymax=quantile(x,probs[2])))+ geom_abline(slope=1, color="gray", linetype="dotted")+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))+ guides(size = guide_legend(title="%"))+ scale_y_continuous(minor_breaks=NULL, limits=c(1,max(5,max(dd$rank))), breaks=c(1,seq(5,max(5,max(dd$rank)),by=5)))+ xlab("Algorithm")+ ylab("Rank") } rankdist.bootstrap.list=function(x,...){ rankDist=melt(lapply(x$bootsrappedRanks,t), value.name="rank") %>% dplyr::rename(algorithm="Var2",task="L1") rankDist } stabilityByAlgorithm.bootstrap.list=function(x, ordering, probs=c(.025,.975), max_size=3, shape=4, single=FALSE,...) { if (length(x$data) < 2) { stop("The stability of rankings by algorithm cannot be computed for less than two tasks.") } rankDist=rankdist.bootstrap.list(x) if (!missing(ordering)) rankDist=rankDist%>%mutate(algorithm=factor(.data$algorithm, levels=ordering)) if (single==FALSE){ ggplot(rankDist)+ geom_count(aes(task , rank, color=algorithm, size = stat(prop*100), group = task ))+ scale_size_area(max_size = max_size)+ stat_summary(aes(task ,rank ), geom="point", shape=shape, fun.data=function(x) data.frame(y=median(x)),...)+ stat_summary(aes(task ,rank ), geom="linerange", fun.data=function(x) data.frame(ymin=quantile(x,probs[1]), ymax=quantile(x,probs[2])))+ facet_wrap(vars(algorithm))+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))+ guides(size = guide_legend(title="%"))+ scale_y_continuous(minor_breaks=NULL, limits=c(1,max(5,max(rankDist$rank))), breaks=c(1,seq(5,max(5,max(rankDist$rank)),by=5)))+ xlab("Task")+ ylab("Rank") } else { pl=list() for (alg in ordering){ rankDist.alg=subset(rankDist, rankDist$algorithm==alg) pl[[alg]]=ggplot(rankDist.alg)+ geom_count(aes(task , rank, color=algorithm, size = stat(prop*100), group = task ))+ scale_size_area(max_size = max_size)+ stat_summary(aes(task , rank ), geom="point", shape=shape, fun.data=function(x) data.frame(y=median(x)),...)+ stat_summary(aes(task ,rank ), geom="linerange", fun.data=function(x) data.frame(ymin=quantile(x,probs[1]), ymax=quantile(x,probs[2])))+ facet_wrap(vars(algorithm))+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))+ guides(size = guide_legend(title="%"))+ scale_y_continuous(minor_breaks=NULL, limits=c(1,max(5,max(rankDist$rank))), breaks=c(1,seq(5,max(5,max(rankDist$rank)),by=5)))+ xlab("Task")+ ylab("Rank") } pl } } stabilityByAlgorithmStacked.bootstrap.list=function(x, ordering, freq=FALSE,...) { if (length(x$data) < 2) { stop("The stability of rankings by algorithm cannot be computed for less than two tasks.") } rankDist=rankdist.bootstrap.list(x) if (!missing(ordering)) rankDist=rankDist%>%mutate(algorithm=factor(.data$algorithm, levels=ordering)) rankDist=rankDist%>%group_by(task)%>%dplyr::count(.data$algorithm, .data$rank) rankDist=rankDist%>%group_by(.data$algorithm)%>%mutate(prop=.data$n/sum(.data$n))%>%ungroup rankDist=rankDist%>%data.frame%>%mutate(rank=as.factor(.data$rank)) results= melt.ranked.list(x, measure.vars="rank", value.name="rank") %>%dplyr::select(-.data$variable) colnames(results)[3]="task" if (!missing(ordering)) results=results%>%mutate(algorithm=factor(.data$algorithm, levels=ordering)) if (freq) ggplot(rankDist) + geom_bar(aes(rank, n, fill=task ), position = "stack", stat = "identity") + facet_wrap(vars(algorithm))+ geom_vline(aes(xintercept=rank, color=task), size=.6, linetype="dotted", data=results )+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))+ xlab("Rank") else ggplot(rankDist)+ geom_bar(aes(rank, prop, fill=task ), position = "stack", stat = "identity")+ facet_wrap(vars(algorithm))+ geom_vline(aes(xintercept=rank, color=task), size=.4, linetype="dotted", data=results)+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))+ xlab("Rank") } -stability.bootstrap=function(x, - ordering, - probs=c(.025,.975), - max_size=3, - size.ranks=.3*theme_get()$text$size, - shape=4,...){ - if (missing(ordering)) ordering= names(sort(t(x$mat[,"rank",drop=F])["rank",])) - a=list(bootsrappedRanks=list(x$bootsrappedRanks), - matlist=list(x$mat)) - names(a$bootsrappedRanks)=names(a$matlist)="" - stabilityByTask.bootstrap.list(a, - ordering=ordering, - probs=probs, - max_size = max_size, - size.ranks=size.ranks, - shape=shape,...) - - -} - - - stabilityByTask.bootstrap.list=function(x, ordering, probs=c(.025,.975), max_size=3, size.ranks=.3*theme_get()$text$size, shape=4, showLabelForSingleTask=FALSE,...){ rankDist=rankdist.bootstrap.list(x) ranks=melt.ranked.list(x, measure.vars="rank", value.name = "full.rank") colnames(ranks)[4]="task" if (!missing(ordering)) { ranks$algorithm=factor(ranks$algorithm, levels=ordering) rankDist=rankDist%>%mutate(algorithm=factor(.data$algorithm, levels=ordering)) } blobPlot <- ggplot(rankDist)+ geom_count(aes(algorithm , rank, color=algorithm, size = stat(prop*100), group = algorithm ))+ scale_size_area(max_size = max_size)+ geom_abline(slope=1, color="gray", linetype="dotted")+ stat_summary(aes(algorithm ,rank ), geom="point", shape=shape, fun.data=function(x) data.frame(y=median(x)),...)+ stat_summary(aes(algorithm ,rank ), geom="linerange", fun.data=function(x) data.frame(ymin=quantile(x,probs[1]), ymax=quantile(x,probs[2])))+ geom_text(aes(x=algorithm,y=1,label=full.rank), nudge_y=-.6, vjust = 0, size=size.ranks, fontface="plain", family="sans", data=ranks) + coord_cartesian(clip = 'off')+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))+ guides(size = guide_legend(title="%"))+ scale_y_continuous(minor_breaks=NULL, limits=c(.4,max(5,max(rankDist$rank))), breaks=c(1,seq(5,max(5,max(rankDist$rank)),by=5)))+ xlab("Algorithm")+ ylab("Rank") # Create multi-panel plot with task names as labels for multi-task data set or single-task data set when explicitly specified if (length(x$data) > 1 || showLabelForSingleTask == TRUE) { blobPlot <- blobPlot + facet_wrap(vars(task)) } return(blobPlot) }