create-column {datamods}

Create new column

Description

This module allow to enter an expression to create a new column in a data.frame.

Usage

create_column_ui(id)

create_column_server(
  id,
  data_r = reactive(NULL),
  allowed_operations = list_allowed_operations()
)

list_allowed_operations()

modal_create_column(
  id,
  title = i18n("Create a new column"),
  easyClose = TRUE,
  size = "l",
  footer = NULL
)

winbox_create_column(
  id,
  title = i18n("Create a new column"),
  options = shinyWidgets::wbOptions(),
  controls = shinyWidgets::wbControls()
)

winbox_update_factor(
  id,
  title = i18n("Update levels of a factor"),
  options = shinyWidgets::wbOptions(),
  controls = shinyWidgets::wbControls()
)

Arguments

id

Module's ID.

data_r

A shiny::reactive() function returning a data.frame.

allowed_operations

A list of allowed operations, see below for details.

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.

Note

User can only use a subset of function: (, c, +, -, *, ^, %%, %/%, /, ==, >, <, !=, <=, >=, &, |, abs, sign, sqrt, ceiling, floor, trunc, cummax, cummin, cumprod, cumsum, exp, expm1, log, log10, log2, log1p, cos, cosh, sin, sinh, tan, tanh, acos, acosh, asin, asinh, atan, atanh, cospi, sinpi, tanpi, gamma, lgamma, digamma, trigamma, round, signif, max, min, range, prod, sum, any, all, pmin, pmax, mean, paste, paste0, substr, nchar, trimws, gsub, sub, grepl, ifelse, length, as.numeric, as.character, as.integer, as.Date, as.POSIXct, as.factor, factor. You can add more operations using the allowed_operations argument, for example if you want to allow to use package lubridate, you can do:

c(list_allowed_operations(), getNamespaceExports("lubridate"))

Examples

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

ui <- fluidPage(
  theme = bslib::bs_theme(version = 5L, preset = "bootstrap"),
  shinyWidgets::html_dependency_winbox(),
  tags$h2("Create new column"),
  fluidRow(
    column(
      width = 4,
      create_column_ui("inline"),
      actionButton("modal", "Or click here to open a modal to create a column"),
      tags$br(), tags$br(),
      actionButton("winbox", "Or click here to open a WinBox to create a column")
    ),
    column(
      width = 8,
      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 <- create_column_server(
    id = "inline",
    data_r = reactive(rv$data)
  )
  observeEvent(data_inline_r(), rv$data <- data_inline_r())

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

  # WinBox window mode
  observeEvent(input$winbox, winbox_create_column("winbox"))
  data_winbox_r <- create_column_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)