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

recorrer tabla javascript

Question

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")