Module to Convert Numeric to Factor — cut-variable • datamods

This module contain an interface to cut a numeric into several intervals.

Usage

cut_variable_ui(id)

cut_variable_server(id, data_r = reactive(NULL))

modal_cut_variable(
  id,
  title = i18n("Convert Numeric to Factor"),
  easyClose = TRUE,
  size = "l",
  footer = NULL
)

winbox_cut_variable(
  id,
  title = i18n("Convert Numeric to Factor"),
  options = shinyWidgets::wbOptions(),
  controls = shinyWidgets::wbControls()
)

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.
options: List of options, see wbOptions().
controls: List of controls, see wbControls().

Value

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

Examples


library(shiny)
library(datamods)
library(reactable)

ui <- fluidPage(
  theme = bslib::bs_theme(version = 5L, preset = "bootstrap"),
  shinyWidgets::html_dependency_winbox(),
  tags$h2("Convert Numeric to Factor"),
  fluidRow(
    column(
      width = 6,
      cut_variable_ui("inline"),
      actionButton("modal", "Or click here to open a modal to cut a variable"),
      tags$br(), tags$br(),
      actionButton("winbox", "Or click here to open a WinBox to cut a variable")
    ),
    column(
      width = 6,
      reactableOutput(outputId = "table"),
      verbatimTextOutput("code")
    )
  )
)

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

  rv <- reactiveValues(data = MASS::Cars93[, c(1, 3, 4, 5, 6, 10)])

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

  # modal window mode
  observeEvent(input$modal, modal_cut_variable("modal"))
  data_modal_r <- cut_variable_server(
    id = "modal",
    data_r = reactive(rv$data)
  )
  observeEvent(data_modal_r(), rv$data <- data_modal_r())

  # WinBox window mode
  observeEvent(input$winbox, winbox_cut_variable("winbox"))
  data_winbox_r <- cut_variable_server(
    id = "winbox",
    data_r = reactive(rv$data)
  )
  observeEvent(data_winbox_r(), rv$data <- data_winbox_r())

  # Show result
  output$table <- renderReactable({
    data <- req(rv$data)
    reactable(
      data = data,
      bordered = TRUE,
      compact = TRUE,
      striped = TRUE
    )
  })

  output$code <- renderPrint({
    attr(rv$data, "code")
  })
}

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