我正在尝试在Shiny中修改反应式数据表,用户可以在其中使用selectInput框中选择的值来更改单个值或整个列。
下面的代码用于普通的table和一个数据表。该代码正在使用selectInput(而不是单个值)和datatable的单个值来更改普通表的第一列。但是我不能使用selectInput更改数据表的第一列。有什么建议吗?
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)
答案 0 :(得分:1)
这应该为您提供一些帮助。让我知道仍然需要什么。参见Unable to pass user inputs into R shiny modules。要点是,您需要将来自主应用程序的输入作为响应传递给模块。
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)