I'm trying to modify a reactive datatable in Shiny, where a user can change a single value, and or a whole column using the value chosen in a selectInput box.
The code below is for a normal table , and a datatable. The code is working to change the first column of the normal table using the selectInput (but not single values), and single values of the datatable. But I can't alter the first column of the datatable using the selectInput. Any suggestions please?
library(lubridate)
library(shiny)
library(shinyjs)
library(tidyverse)
library(DT)
test_data<- data.frame(matrix(data=round(rnorm(8*5),2),ncol=8,nrow=5))
mod_data <- function(input, output, session, data_in) {
data_x <- reactiveValues(
data=data_in
)
proxy = dataTableProxy("data_in")
# observe({
# newvar <- input$var_1
# data_x$data[, 1] <<- newvar
# replaceData(proxy, data_x$data, resetPaging = FALSE)
# })
observeEvent(input$var_1, {
isolate(data_x$data[1, 1] <<- input$var_1)
replaceData(proxy, data_x$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
#manual element update
observeEvent(input$data_mod_cell_edit, {
info = input$data_mod_cell_edit
str(info)
i = info$row
j = info$col+1
k = info$value
str(info)
isolate(
if (j %in% match(c("X1","X2"), names(data_x$data))) {
data_x$data[i, j] <<- DT::coerceValue(k, data_x$data[i, j])
}
)
replaceData(proxy, data_x$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
output$data_mod <- DT::renderDataTable({
DT::datatable(
data=data_x$data,
editable = TRUE,
rownames = FALSE,
class="compact cell-border",
selection = list(mode = "single",
target = "row"
),
options = list(
dom="t",
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
pageLength = 16,
bLengthChange= FALSE,
searching=FALSE
)
)
})
}
modFunctionUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns(id))
}
# Define UI
#ui----
ui= fluidPage(
fluidRow(
br(),
br(),
column(1,selectInput(inputId="var_1", label = h5("var 1"), choices=c(555,444),selected = 555)),
column(4, tableOutput("data")),
column(4, modFunctionUI("data_mod"))
),
#set font size of tables
useShinyjs(),
inlineCSS(list("table" = "font-size: 12px"))
)
#shiny server ----
server=function(input,output,session){
#normal table
global <- reactiveValues( df =test_data )
observe({ global$df$X1 <- input$var_1 })
output$data <- renderTable({global$df })
#datatable
callModule(module=mod_data,
id="data_mod",
data_in=test_data
)
}
# Run the application
shinyApp(ui = ui, server = server)
This should get you some of the way. Let me know what is still needed. See Unable to pass user inputs into R shiny modules . The main point is that you need to pass inputs from the main app as reactives to the module.
library(lubridate)
library(shiny)
library(shinyjs)
library(tidyverse)
library(DT)
test_data<- data.frame(matrix(data=round(rnorm(8*5),2),ncol=8,nrow=5))
mod_data <- function(input, output, session, data_in, var_1) {
data_x <- reactiveValues(
data=data_in
)
proxy = dataTableProxy("data_in")
# observe({
# newvar <- var_1()
# data_x$data[, 1] <<- newvar
# replaceData(proxy, data_x$data, resetPaging = FALSE)
# })
observeEvent(var_1(), {
isolate(data_x$data[1, 1] <<- var_1())
replaceData(proxy, data_x$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
#manual element update
observeEvent(input$data_mod_cell_edit, {
info = input$data_mod_cell_edit
str(info)
i = info$row
j = info$col+1
k = info$value
str(info)
isolate(
if (j %in% match(c("X1","X2"), names(data_x$data))) {
data_x$data[i, j] <<- DT::coerceValue(k, data_x$data[i, j])
}
)
replaceData(proxy, data_x$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
output$data_mod <- DT::renderDataTable({
DT::datatable(
data=data_x$data,
editable = TRUE,
rownames = FALSE,
class="compact cell-border",
selection = list(mode = "single",
target = "row"
),
options = list(
dom="t",
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
pageLength = 16,
bLengthChange= FALSE,
searching=FALSE
)
)
})
}
modFunctionUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns(id))
}
# Define UI
#ui----
ui= fluidPage(
fluidRow(
br(),
br(),
column(1,selectInput(inputId="var_1", label = h5("var 1"), choices=c(555,444),selected = 555)),
column(4, tableOutput("data")),
column(4, modFunctionUI("data_mod"))
),
#set font size of tables
useShinyjs(),
inlineCSS(list("table" = "font-size: 12px"))
)
#shiny server ----
server=function(input,output,session){
#normal table
global <- reactiveValues( df =test_data )
observe({ global$df$X1 <- input$var_1 })
output$data <- renderTable({global$df })
#datatable
callModule(module=mod_data,
id="data_mod",
data_in=test_data,
var_1=reactive(input$var_1)
)
}
# Run the application
shinyApp(ui = ui, server = server)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.