shiny/ggvis version of plotLearningCurve

example.R

library(mlr) ## head
library(shiny)

r = generateLearningCurve(list("classif.rpart", "classif.knn"),
                                            task = sonar.task, percs = seq(0.2, 1, by = 0.2),
                                            measures = list(tpr, fpr, fn, fp), 
                                            resampling = makeResampleDesc(method =  "Subsample", iters = 5),
                                            show.info = FALSE)
plotLearningCurve(r, interactive = TRUE)

plotLearningCurve.R

plotLearningCurve = function(obj, color_variable = NULL, interactive = FALSE) {
  plt_data = reshape2::melt(obj, id.vars = c("learner", "perc"), variable.name = "measure", value.name = "perf")

  nmeas = length(unique(plt_data$measure))
  nlearn = length(unique(plt_data$learner))

  if (is.null(color_variable) & nmeas == 1) {
    color_variable = "learner"
    interactive = FALSE
  } else if (is.null(color_variable) & nlearn == 1) {
    color_variable = "measure"
    interactive = FALSE
  } else if (is.null(color_variable) & interactive) {
    if (nlearn > nmeas) {
      color_variable = "measure"
      pick_variable = "learner"
    } else {
      color_variable = "learner"
      pick_variable = "measure"
    }
  } else if (interactive) {
    if (color_variable == "measure")
      pick_variable = "learner"
    else
      pick_variable = "measure"
  } else {
    stop("cannot plot multiple learners and multiple measures statically")
  }

  if (interactive) {
    ui = shiny::shinyUI(
        shiny::pageWithSidebar(
            shiny::headerPanel("learning curve"),
            shiny::sidebarPanel(
                shiny::selectInput("level_variable",
                                   paste("choose a ", pick_variable),
                                   unique(levels(plt_data[[pick_variable]])))
            ),
            shiny::mainPanel(
                shiny::uiOutput("ggvis_ui"),
                ggvis::ggvisOutput("ggvis")
            )
        ))
    server = shiny::shinyServer(function(input, output) {
      plt_data_sub = shiny::reactive(plt_data[which(plt_data[[pick_variable]] == input$level_variable), ])
      plt = ggvis::ggvis(plt_data_sub, ggvis::prop("x", as.name("perc")),
                         ggvis::prop("y", as.name("perf")),
                         ggvis::prop("stroke", as.name(color_variable)))
      plt = ggvis::layer_lines(plt)
      plt = ggvis::layer_points(plt, ggvis::prop("fill", as.name(color_variable)))
      ggvis::bind_shiny(plt, "ggvis", "ggvis_ui")
    })
    shiny::shinyApp(ui, server)
  } else {
    plt = ggvis::ggvis(plt_data, ggvis::prop("x", as.name("perc")),
                       ggvis::prop("y", as.name("perf")),
                       ggvis::prop("stroke", as.name(color_variable)))
    plt = ggvis::layer_lines(plt)
    ggvis::layer_points(plt, ggvis::prop("fill", as.name(color_variable)))
  }
}