una tablas tabla recorrer obtener fila ejemplos editar datos create con agregar javascript r datatables shiny dt

javascript - recorrer - Desplazamiento vertical condicional en tablas de datos incrustado en una aplicaciĆ³n brillante



recorrer tabla javascript (0)

Preguntas reales

Tengo una DataTable interconectada / creada a través de DT::datatable y procesada a través de DT::renderDataTable .

  1. ¿Cómo habilito de forma condicional el desplazamiento vertical basando la decisión en el valor de shiny::checkboxInput ?

  2. ¿Cómo controlo la altura de mi datatable cuando el desplazamiento vertical está habilitado?

    Estoy un poco perdido con exactamente entender las implicaciones de las opciones scrollY y scrollCollapse y su interacción con otras opciones de DT::renderDataTable o la aplicación misma (por ejemplo, desplazamiento vertical de las "ventanas de la aplicación").

Ejemplo

En el siguiente ejemplo, traté de hacer que el valor de la opción scrollY de DT::renderDataTable dependiera de una entrada de casilla de verificación ( input$action_enable_scrolling ), así como una entrada que define la altura en píxeles ( input$scrolling_y_limit ).

Problema:

La tabla representada resultante no refleja de manera reactiva la elección que se realiza. Parece que una vez que se consideran el valor inicial de input$action_enable_scrolling y input$scrolling_y_limit , ya no se pueden cambiar de forma reactiva

Verá que al cambiar los valores predeterminados, la parte de tabla de datos se comporta de manera diferente:

  • DFLT_action_enable_scrolling <- TRUE
  • DFLT_scrolling_y_limit <- 400

Globales

# Packages ---------------------------------------------------------------- library(shiny) # Variables ---------------------------------------------------------------- DFLT_action_enable_scrolling <- FALSE DFLT_scrolling_y_limit <- 800 # Functions --------------------------------------------------------------- createRecord <- function(input, db) { db$data <- rbind( db$data, data.frame( task = input$task, time = input$time, time_unit = "hour", stringsAsFactors = FALSE ) ) } updateRecord <- function(input, db, selection) { db$data[selection,] <- data.frame( task = input$task, time = input$time, time_unit = "hour", stringsAsFactors = FALSE ) } deleteRecord <- function(db, selection) { db$data <- db$data[-selection,] } niceNames <- function(x) { s <- strsplit(x, " |_|//.", perl = TRUE)[[1]] paste(toupper(substring(s, 1,1)), substring(s, 2), sep = "", collapse = " ") }

UI

ui <- fluidPage( div( style = "display:inline-block", p(), actionButton("action_trigger", "Create") ), tabsetPanel( tabPanel( title = "Scrolling options", checkboxInput("action_enable_scrolling", "Enable Y-scrolling", value = DFLT_action_enable_scrolling), numericInput("scrolling_y_limit", "Height limit for Y-scrolling (in px)", value = DFLT_scrolling_y_limit) ) ), hr(), uiOutput("ui_input"), hr(), h3("Database"), DT::dataTableOutput("dt") )

Servidor

server <- function(input, output, session) { ## Initialize DB // db <- reactiveValues(data = data.frame( task = character(), time = numeric(), time_unit = character() )[-1,]) ## UI control // ui_control <- reactiveValues( case = c("hide", "create", "update")[1], selection = NULL, refresh = TRUE ) observeEvent(input$action_trigger, { ui_control$case <- "create" }) ## Render UI // output$ui_input <- renderUI({ case <- ui_control$case if (case == "hide") return() ## Case dependent input // if (case == "create") { task <- ifelse(is.null(tmp <- isolate(input$task)), "", tmp) time <- ifelse(is.null(tmp <- isolate(input$time)), "", tmp) buttons <- div( style = "display:inline-block", actionButton("action_create", "Create"), actionButton("action_cancel", "Cancel") ) updateTextInput(session, "first") } else if (case == "update") { task <- db$data[ui_control$selection, "task"] time <- db$data[ui_control$selection, "time"] buttons <- div( style = "display:inline-block", actionButton("action_update", "Update"), actionButton("action_cancel", "Cancel"), p(), actionButton( "action_delete", "Delete", icon = icon("exclamation-triangle") ) ) } else { stop(sprintf("Invalid case: %s", case)) } tagList( textInput("task", "Task", task), numericInput("time", "Time", time), buttons ) }) ## CRUD operations // observeEvent(input$action_create, { createRecord(input, db = db) ui_control$case <- "hide" }) observeEvent(input$action_update, { updateRecord(input, db = db, selection = ui_control$selection) ui_control$refresh <- NULL ui_control$refresh <- TRUE # ui_control$case <- "hide" }) observeEvent(input$action_delete, { deleteRecord(db = db, selection = ui_control$selection) tmp <- ui_control$selection[1] - 1 if (tmp == 0) tmp <- NULL ui_control$selection <- tmp ui_control$refresh <- NULL ui_control$refresh <- TRUE # ui_control$case <- "hide" }) observeEvent(input$action_cancel, { ui_control$case <- "hide" }) ## Selection // observe({ idx <- input$dt_rows_selected ui_control$selection <- idx }) observe({ idx <- ui_control$selection if (!is.null(idx)) { ui_control$case <- "update" } else { ui_control$case <- "hide" } }) ## Render table: preparations // observeEvent(input$action_enable_scrolling, { ui_control$refresh <- NULL ui_control$refresh <- TRUE }) observeEvent(input$scrolling_y_limit, { ui_control$refresh <- NULL ui_control$refresh <- TRUE }) dt_options = reactive({ scroll <- input$action_enable_scrolling list( dom = "ltipr", autoWidth = TRUE, scrollX = TRUE, scrollY = if (scroll) { sprintf("%spx", input$scrolling_y_limit * 1) }, scrollCollapse = if (scroll) { TRUE }, lengthMenu = list( c(3, 5, -1), c(3, 5, "All") ), iDisplayLength = 3 ) }) # Render table: DT // output$dt <- DT::renderDataTable({ if (!ui_control$refresh) { return() } ## Note: ## Not really necessary for this example use case as `db$data` already ## introduces a reactive dependency. ## However, that might not always be the case for data I/O when an ## actual database is involved. In this case, this part will most likely ## have to be informed about required re-rendering by an explicit reactive ## value that other parts update upon I/O operations tmp <- db$data names(tmp) <- sapply(names(tmp), niceNames) tmp }, selection = "single", options = dt_options()) # DT proxy // proxy <- DT::dataTableProxy("dt") ## Keep/restory previous selection // observe({ ui_control$refresh DT::selectRows(proxy, as.numeric(ui_control$selection)) }) ## Resets // observe({ if (ui_control$case == "create") { updateTextInput(session, "task", value = sprintf("Test %s", Sys.time())) updateTextInput(session, "time", value = 1) } }) }

correr

shinyApp(ui, server)

Aplicación de referencia en Gist

Las secciones utilizadas anteriormente también están contenidas en mi aplicación de referencia, que incluye algunas cosas / aprendizajes relacionados con la funcionalidad datable en caso de que le interese:

shiny::runGist("https://gist.github.com/rappster/d48916fbf8e8d0456ae2")