diff --git a/R/report.R b/R/report.R index d48f170..c9d8f05 100644 --- a/R/report.R +++ b/R/report.R @@ -1,165 +1,165 @@ report <- function(object,...) UseMethod("report") report.default <- function(object, ...) stop("not implemented for this class") #' Generates a benchmarking report with bootstrapping results #' #' Generates a benchmarking report in PDF, HTML or Word format with bootstrapping results. #' It contains the rankings, plots of the raw assessment data and plots of the ranking stability. #' For multi-task challenges, it also contains plots of cross-task insights. If you are interested in #' the individual plots as separate files, set argument \code{clean} to \code{FALSE} and specify \code{fig.format}. #' #' @param object The ranked (bootstrapped) assessment data set. #' @param consensus The rank aggregation across tasks (consensus ranking). Only needed for a multi-task data set. #' @param file A string specifying the file name of the report. It allows for specifying the output file path as well, #' otherwise the working directory is used. If \code{file} does not have a file extension, an extension will be automatically #' added according to the output format given in \code{format}. If the argument is omitted, the report is created in a #' temporary folder with file name "report". #' @param title A string specifying the title of the report. #' @param colors The color scheme that is applied to the plots. #' @param format A string specifying the format of the report. The options are "PDF", "HTML" or "Word". #' @param latex_engine A string specifying the LaTeX engine for producing PDF output. The Options are "pdflatex", "lualatex", and "xelatex". #' @param clean A boolean indicating whether intermediate files (e.g. individual plots) should be kept. Using \code{TRUE} will clean #' intermediate files that are created during rendering. #' @param fig.format A vector of strings containing the file format of the figures that are not removed if \code{clean} is set to \code{FALSE}. #' The options are "jpeg", "png" and "pdf", e.g. \code{fig.format = c("jpeg", "png", "pdf")}. #' @param dpi A positive integer specifying the resolution of the generated plot (\code{fig.format} "jpeg" or "png") in dots per inch (DPI). #' @param open A boolean specifying whether the report should be opened with the default system viewer after generation. #' @param ... Further arguments passed to or from other functions. #' #' @return #' #' @examples #' @export report.bootstrap.list=function(object, consensus, file, title="", colors=default_colors, format="PDF", latex_engine="pdflatex", clean=TRUE, fig.format = NULL, # file format of figures if clean==FALSE, can be vector, e.g. fig.format=c('jpeg','png', 'pdf') dpi = 150, # DPI, relevant for bitmaps if clean==FALSE and fig.format specified open=TRUE,...){ # Copy the report file to a temporary directory before processing it, in # case we don't have write permissions to the current working dir (which # can happen when deployed). if (missing(file)) tempReport <- file.path(tempdir(), "report.Rmd") else { a=strsplit(file,"/")[[1]] path=paste0(a[-length(a)],collapse="/") if (path=="") tempReport=file.path(paste0(strsplit(a[length(a)], ".", fixed=T)[[1]][1],".Rmd")) else tempReport=file.path(path,paste0(strsplit(a[length(a)], ".", fixed=T)[[1]][1],".Rmd")) } file.copy(file.path(system.file("appdir", package = "challengeR"), "reportMultiple.Rmd"), tempReport, overwrite = TRUE) if (length(object$matlist) > 1) { consensus = consensus isMultiTask = TRUE } else { consensus = NULL isMultiTask = FALSE } bootstrappingEnabled = TRUE if (is(object, "ranked.list")) { bootstrappingEnabled = FALSE } # Set up parameters to pass to Rmd document if (!is.null(fig.format) & format=="PDF") fig.format=c("pdf",fig.format) if (!is.null(fig.format) && fig.format[1]=="pdf" && format=="Word") fig.format <- c(fig.format[-1], fig.format[1]) # in word avoid use of pdf to be embedded in document params <- list( object=object, consensus=consensus, name=title, colors=colors, isMultiTask=isMultiTask, bootstrappingEnabled=bootstrappingEnabled, fig.format = fig.format, dpi = dpi ) # Knit the document, passing in the `params` list, and eval it in a # child of the global environment (this isolates the code in the document # from the code in this app). out <- render(tempReport, switch( format, PDF = pdf_document(number_sections=T, latex_engine=latex_engine), HTML = html_document(number_sections=T), Word = word_document(df_print="kable") ), params = params, envir = new.env(parent = globalenv()), clean = clean, ... ) if (!missing(file)){ if (is.na(strsplit(file,".",fixed=T)[[1]][2])) file=paste0(file, ".", strsplit(out,".",fixed=T)[[1]][2]) file.rename(out, file) } else file=out file.remove(tempReport) if (open) system(paste0('open "', file, '"')) } #' Generates a benchmarking report without bootstrapping results #' #' Generates a benchmarking report in PDF, HTML or Word format without bootstrapping results. #' It contains the rankings, plots of the raw assessment data and plots of the ranking stability. #' For multi-task challenges, it also contains plots of cross-task insights. If you are interested in #' the individual plots as separate files, set argument \code{clean} to \code{FALSE} and specify \code{fig.format}. #' -#' @param object The ranked (bootstrapped) assessment data set. +#' @param object The ranked assessment data set. #' @param consensus The rank aggregation across tasks (consensus ranking). Only needed for a multi-task data set. #' @param file A string specifying the file name of the report. It allows for specifying the output file path as well, #' otherwise the working directory is used. If \code{file} does not have a file extension, an extension will be automatically #' added according to the output format given in \code{format}. If the argument is omitted, the report is created in a #' temporary folder with file name "report". #' @param title A string specifying the title of the report. #' @param colors The color scheme that is applied to the plots. #' @param format A string specifying the format of the report. The options are "PDF", "HTML" or "Word". #' @param latex_engine A string specifying the LaTeX engine for producing PDF output. The Options are "pdflatex", "lualatex", and "xelatex". #' @param clean A boolean indicating whether intermediate files (e.g. individual plots) should be kept. Using \code{TRUE} will clean #' intermediate files that are created during rendering. #' @param fig.format A vector of strings containing the file format of the figures that are not removed if \code{clean} is set to \code{FALSE}. #' The options are "jpeg", "png" and "pdf", e.g. \code{fig.format = c("jpeg", "png", "pdf")}. #' @param dpi A positive integer specifying the resolution of the generated plot (\code{fig.format} "jpeg" or "png") in dots per inch (DPI). #' @param open A boolean specifying whether the report should be opened with the default system viewer after generation. #' @param ... Further arguments passed to or from other functions. #' #' @return #' #' @examples #' @export report.ranked.list=function(object, consensus, file, title="", colors=default_colors, format="PDF", latex_engine="pdflatex", clean=TRUE, fig.format = NULL, # file format of figures if clean=FALSE, can be vector, e.g. fig.format=c('jpeg','png', 'pdf') dpi = 150, # DPI, relevant for bitmaps if clean==FALSE and fig.format specified open=TRUE, ...){ report.bootstrap.list(object, consensus, file, title, colors, format, latex_engine, clean, fig.format, dpi, open, ...) } diff --git a/R/subset.R b/R/subset.R index 9f8285f..6c238e1 100644 --- a/R/subset.R +++ b/R/subset.R @@ -1,119 +1,183 @@ subset <- function(x,...) UseMethod("subset") subset.default <- function(x, ...) base::subset(x, ...) subset.comparedRanks.list=function(x, tasks,...){ res=x[tasks] class(res)="comparedRanks.list" res } subset.list=function(x, tasks,...){ x[tasks] } subset.aggregated.list=function(x, tasks,...){ call=match.call(expand.dots = T) if (!is.null(as.list(call$top))) stop("Subset of algorithms only sensible for single task challenges.") matlist=x$matlist[tasks] res=list(matlist=matlist, call=list(x$call,call), data=x$data, FUN = . %>% (x$FUN) %>% (call) ) class(res)=class(x) res } which.top=function(object, top){ mat=object$mat[object$mat$rank<=top,] rownames(mat)#[order(mat$rank)] } - - +#' Extracts a subset of algorithms or tasks +#' +#' Extracts the top performing algorithms or a subset of tasks. +#' +#' @section Reports for subsets (top list) of algorithms: +#' If ties are present in the ranking, the subset will consist of more than \code{top} algorithms. +#' Line plots for ranking robustness can be used to check whether algorithms performing well in other +#' ranking methods are excluded. Bootstrapping still takes entire uncertainty into account. +#' Podium plots and ranking heatmaps neglect excluded algorithms. Only available for single-task challenges +#' (for multi-task challenges not sensible because each task would contain a different set of algorithms). +#' +#' @section Reports for subsets of tasks: +#' You may want to recompute the consensus ranking after creating the subset. An error will be raised +#' if a task identifier is not contained in the assessment data set to avoid subsequent errors. +#' +#' +#' @param x The ranked asssessment data set. +#' @param top A positive integer specifying the amount of top performing algorithms to be retrieved. +#' @param tasks A vector of strings containing the task identifiers that should remain in the subset. +#' @param ... Further arguments passed to or from other functions. +#' +#' @return An S3 object of class "ranked.list" to represent a ranked assessment data set. +#' +#' @examples +#' +#' \dontrun{ +#' # only show the top 3 algorithms according to the chosen ranking method +#' subset(ranking, top = 3) %>% report(...) +#' } +#' +#' \dontrun{ +#' # restrict report to tasks "task1" and "task2" +#' subset(ranking, tasks=c("task1", "task2")) %>% report(...) +#' } +#' +#' @export subset.ranked.list <- function(x, top, tasks,...) { - -# if (!missing(tasks) & length(x$matlist) == 1) stop("Subset of tasks only sensible for multi task challenges.") + if (!missing(top) & length(x$matlist) != 1) stop("Subset of algorithms only sensible for single-task challenges. Otherwise no consensus ranking is possible.") - + if (!missing(top)){ taskMat <- x$matlist[[1]] taskData <- x$data[[1]] objectTop=x objectTop$matlist[[1]]=taskMat[taskMat$rank<=top,] - + taskMatRowNames <- rownames(objectTop$matlist[[1]]) attribute <- attr(objectTop$data,"algorithm") - + selectedRowNames <- taskData[[attribute]] %in% taskMatRowNames objectTop$data[[1]] <- taskData[selectedRowNames,] if (is.factor(objectTop$data[[1]][[attribute]])) objectTop$data[[1]][[attribute]] <- droplevels(objectTop$data[[1]][[attribute]]) - + objectTop$fulldata=x$data return(objectTop) } else if (!missing(tasks)){ - + if (is.character(tasks) && any(!tasks%in%names(x$matlist))) { - stop("There is/are no task(s) called ",paste(tasks[!tasks%in%names(x$matlist)],collapse = " and "),".") + stop("There is/are no task(s) called ",paste(tasks[!tasks%in%names(x$matlist)],collapse = " and "),".") } res=list(matlist=x$matlist[tasks], data=x$data[tasks], call=x$call, FUN=x$FUN, FUN.list=x$FUN.list ) - + attrib=attributes(x$data) attrib$names=attr(res$data,"names") attributes(res$data)=attrib class(res)=c("ranked.list","list") return(res) } } - - +#' Extracts a subset of algorithms or tasks +#' +#' Extracts the top performing algorithms or a subset of tasks. +#' +#' @section Reports for subsets (top list) of algorithms: +#' If ties are present in the ranking, the subset will consist of more than \code{top} algorithms. +#' Line plots for ranking robustness can be used to check whether algorithms performing well in other +#' ranking methods are excluded. Bootstrapping still takes entire uncertainty into account. +#' Podium plots and ranking heatmaps neglect excluded algorithms. Only available for single-task challenges +#' (for multi-task challenges not sensible because each task would contain a different set of algorithms). +#' +#' @section Reports for subsets of tasks: +#' You may want to recompute the consensus ranking after creating the subset. An error will be raised +#' if a task identifier is not contained in the assessment data set to avoid subsequent errors. +#' +#' +#' @param x The bootstrapped, ranked asssessment data set. +#' @param top A positive integer specifying the amount of top performing algorithms to be retrieved. +#' @param tasks A vector of strings containing the task identifiers that should remain in the subset. +#' @param ... Further arguments passed to or from other functions. +#' +#' @return An S3 object of class "bootstrap.list" to represent a bootstrapped, ranked assessment data set. +#' +#' @examples +#' +#' \dontrun{ +#' # only show the top 3 algorithms according to the chosen ranking method +#' subset(ranking_bootstrapped, top = 3) %>% report(...) +#' } +#' +#' \dontrun{ +#' # restrict report to tasks "task1" and "task2" and recompute consensus ranking +#' meanRanks <- subset(ranking, tasks = c("task1", "task2")) %>% consensus(method = "euclidean") +#' } +#' +#' @export subset.bootstrap.list=function(x, top, tasks, ...) { - - # if (!missing(tasks) & length(x$matlist) == 1) stop("Subset of tasks only sensible for multi task challenges.") + if (!missing(top) & length(x$matlist) != 1) stop("Subset of algorithms only sensible for single-task challenges. Otherwise no consensus ranking is possible.") - + if (!missing(top)){ objectTop <- subset.ranked.list(x, top = top) - + objectTop$bootsrappedRanks[[1]] <- objectTop$bootsrappedRanks[[1]][rownames(objectTop$matlist[[1]]),] objectTop$bootsrappedAggregate[[1]] <- objectTop$bootsrappedAggregate[[1]][rownames(objectTop$matlist[[1]]),] return(objectTop) } else if (!missing(tasks)){ if (is.character(tasks) && any(!tasks%in%names(x$matlist))) { - stop("There is/are no task(s) called ",paste(tasks[!tasks%in%names(x$matlist)],collapse = " and "),".") + stop("There is/are no task(s) called ",paste(tasks[!tasks%in%names(x$matlist)],collapse = " and "),".") } - + res=list(bootsrappedRanks=x$bootsrappedRanks[tasks], bootsrappedAggregate=x$bootsrappedAggregate[tasks], matlist=x$matlist[tasks], data=x$data[tasks], FUN=x$FUN ) - + attrib=attributes(x$data) attrib$names=attr(res$data,"names") attributes(res$data)=attrib class(res)="bootstrap.list" return(res) } } - -