Module to Reorder the Levels of a Factor Variable

This module contain an interface to reorder the levels of a factor variable.

Usage

update_factor_ui(id)

update_factor_server(id, data_r = reactive(NULL))

modal_update_factor(
  id,
  title = "Update levels of a factor",
  easyClose = TRUE,
  size = "l",
  footer = NULL
)

Arguments

id: Module ID.
data_r: A shiny::reactive() function returning a data.frame.
title: An optional title for the dialog.
easyClose: If TRUE, the modal dialog can be dismissed by clicking outside the dialog box, or be pressing the Escape key. If FALSE (the default), the modal dialog can't be dismissed in those ways; instead it must be dismissed by clicking on a modalButton(), or from a call to removeModal() on the server.
size: One of "s" for small, "m" (the default) for medium, "l" for large, or "xl" for extra large. Note that "xl" only works with Bootstrap 4 and above (to opt-in to Bootstrap 4+, pass bslib::bs_theme() to the theme argument of a page container like fluidPage()).
footer: UI for footer. Use NULL for no footer.

Value

A shiny::reactive() function returning the data.

Examples


library(shiny)
library(datamods)
library(ggplot2)

ui <- fluidPage(
  theme = bslib::bs_theme(version = 5L, preset = "bootstrap"),
  tags$h2("Reorder the Levels of a Factor"),
  fluidRow(
    column(
      width = 6,
      update_factor_ui("id"),
      actionButton("modal", "Or click here to open a modal to update factor's level")
    ),
    column(
      width = 6,
      selectInput(
        "var",
        label = "Variable to plot:",
        choices = NULL
      ),
      plotOutput("plot"),
      verbatimTextOutput("res")
    )
  )
)
#> Warning: i18n: translation for 'Factor variable to reorder:' not found!
#> Warning: i18n: translation for 'Sort levels' not found!
#> Warning: i18n: translation for 'Sort count' not found!
#> Warning: i18n: translation for 'Create a new variable (otherwise replaces the one selected)' not found!
#> Warning: i18n: translation for 'Update factor variable' not found!

server <- function(input, output, session) {

  rv <- reactiveValues(data = MASS::Cars93[c(1, 2, 3, 9, 10, 11, 16, 26, 27)])
  observe(
    updateSelectInput(inputId = "var", choices = names(rv$data))
  )

  # Inline mode
  data_inline_r <- update_factor_server(
    id = "id",
    data_r = reactive(rv$data)
  )
  observeEvent(data_inline_r(), rv$data <- data_inline_r())

  # modal window mode
  observeEvent(input$modal, modal_update_factor("modal"))
  data_modal_r <- update_factor_server(
    id = "modal",
    data_r = reactive(rv$data)
  )
  observeEvent(data_modal_r(), {
    shiny::removeModal()
    rv$data <- data_modal_r()
  })

  # Plot results
  output$plot <- renderPlot({
    req(input$var, rv$data)
    ggplot(rv$data) +
      aes(x = !!sym(input$var)) +
      geom_bar()
  })
  # Show results
  output$res <- renderPrint({
    data <- req(rv$data)
    str(data)
  })
}

if (interactive())
  shinyApp(ui, server)