Commit f662cf67 authored by Jakob Wirbel's avatar Jakob Wirbel

add option to (by default) suppress plotting of repeated CV run model evaluations.

parent c63df045
...@@ -9,9 +9,11 @@ ...@@ -9,9 +9,11 @@
#' Precision-recall (PR)-curves for the different cross-validation #' Precision-recall (PR)-curves for the different cross-validation
#' repetitions. #' repetitions.
#' @usage model.evaluation.plot(..., fn.plot = NULL, #' @usage model.evaluation.plot(..., fn.plot = NULL,
#' colours=NULL, verbose = 1) #' colours=NULL, show.all=FALSE, verbose = 1)
#' @param ... one or more object of class \link{siamcat-class}, can be named #' @param ... one or more object of class \link{siamcat-class}, can be named
#' @param fn.plot string, filename for the pdf-plot #' @param fn.plot string, filename for the pdf-plot
#' @param show.all boolean, Should all repeated cross-validation models be
#' plotted?
#' @param colours colour specification for the different \link{siamcat-class}- #' @param colours colour specification for the different \link{siamcat-class}-
#' objects, defaults to \code{NULL} which will cause the colours to be #' objects, defaults to \code{NULL} which will cause the colours to be
#' picked from the \code{'Set1'} palette #' picked from the \code{'Set1'} palette
...@@ -34,7 +36,7 @@ ...@@ -34,7 +36,7 @@
#' 'Example_2'=siamcat_example, colours=c('red', 'blue'), #' 'Example_2'=siamcat_example, colours=c('red', 'blue'),
#' fn.plot='./eval.pdf') #' fn.plot='./eval.pdf')
model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL, model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL,
verbose = 1) { show.all = FALSE, verbose = 1) {
if (verbose > 1) if (verbose > 1)
message("+ starting model.evaluation.plot") message("+ starting model.evaluation.plot")
s.time <- proc.time()[3] s.time <- proc.time()[3]
...@@ -91,6 +93,7 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL, ...@@ -91,6 +93,7 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL,
legend.val <- c(legend.val, legend.val <- c(legend.val,
as.numeric(single.roc.plot(args[[i]], as.numeric(single.roc.plot(args[[i]],
colours[i], colours[i],
show.all=show.all,
verbose=verbose))) verbose=verbose)))
} }
if (!is.null(names(args))) { if (!is.null(names(args))) {
...@@ -125,6 +128,7 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL, ...@@ -125,6 +128,7 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL,
legend.val <- c(legend.val, legend.val <- c(legend.val,
as.numeric(single.pr.plot(args[[i]], as.numeric(single.pr.plot(args[[i]],
colours[i], colours[i],
show.all=show.all,
verbose=verbose))) verbose=verbose)))
} }
if (!is.null(names(args))) { if (!is.null(names(args))) {
...@@ -161,7 +165,8 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL, ...@@ -161,7 +165,8 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL,
} }
# ROC # ROC
if (is.null(colours)) colours <- 'black' if (is.null(colours)) colours <- 'black'
auroc <- single.roc.plot(args[[1]], colours, verbose=verbose) auroc <- single.roc.plot(args[[1]], colours,
show.all=show.all, verbose=verbose)
text(0.7, 0.1, paste(auc.text, format(auroc, digits = 3))) text(0.7, 0.1, paste(auc.text, format(auroc, digits = 3)))
# PR # PR
...@@ -179,7 +184,8 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL, ...@@ -179,7 +184,8 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL,
label <- label(args[[1]]) label <- label(args[[1]])
abline(h = mean(label$label == max(label$info)), abline(h = mean(label$label == max(label$info)),
lty = 3) lty = 3)
auprc <- single.pr.plot(args[[1]], colours, verbose=verbose) auprc <- single.pr.plot(args[[1]], colours,
show.all=show.all, verbose=verbose)
text(0.7, 0.1, paste(pr.text, format(auprc, digits = 3))) text(0.7, 0.1, paste(pr.text, format(auprc, digits = 3)))
} else { } else {
stop('No SIAMCAT object supplied. Exiting...') stop('No SIAMCAT object supplied. Exiting...')
...@@ -202,12 +208,12 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL, ...@@ -202,12 +208,12 @@ model.evaluation.plot <- function(..., fn.plot=NULL, colours = NULL,
} }
single.pr.plot <- function(siamcat, colour, verbose) { single.pr.plot <- function(siamcat, colour, show.all, verbose) {
eval.data <- eval_data(siamcat) eval.data <- eval_data(siamcat)
# pr curves for resampling # pr curves for resampling
if (!is.null(eval.data$prc.all)) { if (!is.null(eval.data$prc.all) & show.all) {
aucspr.all = eval.data$auprc.all aucspr.all = eval.data$auprc.all
for (c in seq_len(length(eval.data$prc.all))) { for (c in seq_len(length(eval.data$prc.all))) {
pr = eval.data$prc.all[[c]] pr = eval.data$prc.all[[c]]
...@@ -248,11 +254,11 @@ single.pr.plot <- function(siamcat, colour, verbose) { ...@@ -248,11 +254,11 @@ single.pr.plot <- function(siamcat, colour, verbose) {
return(auprc) return(auprc)
} }
single.roc.plot <- function(siamcat, colour, verbose) { single.roc.plot <- function(siamcat, colour, show.all, verbose) {
eval.data <- eval_data(siamcat) eval.data <- eval_data(siamcat)
if (!is.null(eval.data$roc.all)){ if (!is.null(eval.data$roc.all) & show.all){
aucs = eval.data$auroc.all aucs = eval.data$auroc.all
for (c in seq_along(eval.data$roc.all)) { for (c in seq_along(eval.data$roc.all)) {
roc.c = eval.data$roc.all[[c]] roc.c = eval.data$roc.all[[c]]
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment