diff --git a/NAMESPACE b/NAMESPACE index de641e4..e883615 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,235 +1,231 @@ #exportPattern("^[[:alpha:]]+") export( "aggregate.bootstrap", "aggregate.bootstrap.list", "aggregate.challenge", "aggregate.ranked", "aggregate.ranked.list", "aggregateList", #? - "aggregateThenRank", + "aggregateThenRank", "as.challenge", "as.relation.challenge.incidence", "as.relation.ranked.list", "bootstrap", "bootstrap.ranked", "bootstrap.ranked.list", #"bootstrap.default", "boxplot.ranked", "boxplot.ranked.list", "boxplot.bootstrap.list", "boxplot.comparedRanks.list", - #"check_strict_preference", + #"check_strict_preference", "compareRanks", "compareRanks.ranked", "compareRanks.ranked.list", # "compareRanks.default", - "consensus", "consensus.ranked.list", #"consensus.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", + "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", + "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", + "rankFrequencies", "rankFrequencies.bootstrap", "rankFrequencies.bootstrap.list", #"rankFrequencies.default", #"rankNA2", "rankThenAggregate", "rankingHeatmap","rankingHeatmap.ranked","rankingHeatmap.ranked.list", "relation_dissimilarity.ranked.list", - "report", "report.bootstrap", "report.bootstrap.list", - "second", + "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", + "significanceMap", + "spearmansFootrule", "spearmansWeightedFootrule", + "splitby", "stability", "stabilityByAlgorithm", "stabilityByAlgorithmStacked","stabilityByTask", "stability.ranked.list", "stability.bootstrap","relation_dissimilarity", - "stabilityByAlgorithm.bootstrap.list", + "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", + "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", + "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) 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,challenge) S3method(rankingHeatmap,ranked) 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) S3method(report,ranked.list) -S3method(report,bootstrap) S3method(report,default) - - diff --git a/R/report.R b/R/report.R index ce1fd7c..dec475f 100644 --- a/R/report.R +++ b/R/report.R @@ -1,300 +1,162 @@ report <- function(object,...) UseMethod("report") report.default <- function(object, ...) stop("not implemented for this class") -report.bootstrap=function(object, - file, - title="", - colors=default_colors, - format="PDF", - latex_engine="pdflatex", - 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"), - "reportSingle.Rmd"), - tempReport, - overwrite = TRUE) - - # Set up parameters to pass to Rmd document - params <- list( - object=object, - name=title, - colors=colors - ) - - - # 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() - ), - params = params, - envir = new.env(parent = globalenv()), - ... - ) - - 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, '"')) - -} - - - report.bootstrap.list=function(object, consensus, file, title="", colors=default_colors, format="PDF", latex_engine="pdflatex", 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 } # Set up parameters to pass to Rmd document params <- list( object=object, consensus=consensus, name=title, colors=colors, isMultiTask=isMultiTask, bootstrappingEnabled=TRUE ) # 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). # render(tempReport, output_file = file, # params = params, # envir = new.env(parent = globalenv()) # ) 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()), ... ) 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, '"')) - } - - -######################## - - -report.ranked=function(object, - file, - title="", - colors=default_colors, - format="PDF", - latex_engine="pdflatex", - 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"), - "reportSingleShort.Rmd"), - tempReport, - overwrite = TRUE) - - # Set up parameters to pass to Rmd document - params <- list( - object=object, - name=title, - colors=colors - ) - - - # 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() - ), - params = params, - envir = new.env(parent = globalenv()),... - ) - - 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, '"')) - -} - - - report.ranked.list=function(object, consensus, file, title="", colors=default_colors, format="PDF", latex_engine="pdflatex", 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 } # Set up parameters to pass to Rmd document params <- list( object=object, consensus=consensus, name=title, colors=colors, isMultiTask=isMultiTask, bootstrappingEnabled=FALSE ) # 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()), ... ) 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, '"')) - } - -