tidymodels / shinymodels

https://shinymodels.tidymodels.org/
Other
46 stars 5 forks source link

consider selecting tuning parameter values via a table #32

Closed topepo closed 3 years ago

topepo commented 3 years ago

The autoplot() method for selecting a tuning parameter looks nice but is a bit complex and kludgy to use.

Instead, we might want to use an interactive table where users can click on a row to get the candidate model that they like.

Here's a simple example:

# See
# https://shiny.rstudio.com/articles/datatables.html
# https://yihui.shinyapps.io/DT-selection/

# ------------------------------------------------------------------------------

library(shiny)
library(DT)
library(tidymodels)
tidymodels_prefer()

# ------------------------------------------------------------------------------

# Example from tune: cacluate and reformat performance metrics for each candidate
# model
performance <-
  ames_grid_search %>%
  collect_metrics() %>%
  dplyr::relocate(metric = .metric, estimate = mean) %>%
  dplyr::select(-.estimator, -n, -std_err)

# Save info to round real number columns (if any)
is_real_number <- map_lgl(performance, ~ is.numeric(.x) & !is.integer(.x))
reals <- names(is_real_number)[is_real_number]

# ------------------------------------------------------------------------------

ui <- fluidPage(
  title = "Examples of DataTables",
  sidebarLayout(
    sidebarPanel(
      verbatimTextOutput('chosen_config')
    ),
    mainPanel(
      DT::dataTableOutput("metrics")
    )
  )
)

server <- function(input, output) {
  output$metrics <- DT::renderDataTable({
    performance %>%
      dplyr::select(-.config) %>%
      DT::datatable(
        selection = "single",
        filter = "top",
        fillContainer = FALSE,
        rownames = FALSE
      ) %>%
      formatSignif(columns = reals, digits = 3)
  })

  output$chosen_config = renderPrint({
    paste("Selected:", performance$.config[input$metrics_rows_selected])
    })

}

shinyApp(ui, server)

This looks like:

image

topepo commented 3 years ago

Here's an updated example that uses reactable:

# See
# https://glin.github.io/reactable/articles/examples.html

# ------------------------------------------------------------------------------

library(shiny)
library(reactable)  # remotes::install_dev("reactable")
library(crosstalk)
library(tidymodels)
tidymodels_prefer()

# ------------------------------------------------------------------------------

# Example from tune: calculate and reformat performance metrics for each candidate
# model
performance <-
  ames_grid_search %>%
  collect_metrics() %>%
  dplyr::relocate(metric = .metric, estimate = mean) %>%
  dplyr::select(-.estimator, -n, -std_err)

# ------------------------------------------------------------------------------

# Make a shared data source; don't show .config in the table but keep in original data
.perf <- SharedData$new(performance %>% dplyr::select(-.config))
sticky_style <- list(backgroundColor = "#f7f7f7")

# ------------------------------------------------------------------------------

ui <- fluidPage(
  title = "Examples of DataTables",
  sidebarLayout(
    sidebarPanel(
      verbatimTextOutput('chosen_config')
    ),
    mainPanel(
      h3("Select a performance metric:"),
      filter_checkbox("metric_select", "", .perf, ~metric, inline = TRUE),
      h3("Select a tuning parameter combination:"),
      reactableOutput("metrics")
    )
  )
)

server <- function(input, output) {
  output$metrics <- renderReactable({
    reactable(
      .perf,
      filterable = TRUE,
      selection = "single",
      defaultColDef = colDef(
        cell = function(value) format(value, digits = 3, scientific = FALSE)
      ),
      columns = list(
        metric = colDef(
          sticky = "left",
          style = sticky_style,
          headerStyle = sticky_style
        ),
        estimate = colDef(
          sticky = "left",
          style = sticky_style,
          headerStyle = sticky_style
        )
      ),
      bordered = TRUE,
      highlight = TRUE
    )
  })

  output$chosen_config = renderPrint({
    chosen_config <- performance$.config[getReactableState("metrics", "selected")]

    cat("I choose:\n", chosen_config, "\n")
  })

}

shinyApp(ui, server)

image

adhikars11 commented 3 years ago

Merged to main in the recent PR. For now we are using DT::datatable, but we will look into reactable as an alternate.

github-actions[bot] commented 1 year ago

This issue has been automatically locked. If you believe you have found a related problem, please file a new issue (with a reprex: https://reprex.tidyverse.org) and link to this issue.