[英]Is there a way to use picker/selectInput in conjunction with an editable, reactive DT in shiny?
我一直在努力解决以下问题,并且在 SO 上找不到合适的解决方案。
这是我对 DataTable 的要求
提前谢谢你的帮助!
df <- iris
species <- unique(as.character(df$Species))
width <- unique(df$Petal.Width)
#==========================================UI=======================================================#
ui = navbarPage("CSAT & SA", theme = shinytheme("flatly"),
tabPanel("Sentiment Analysis",
sidebarLayout(
sidebarPanel(
pickerInput(inputId = "species",
label = "Species", selected = species,
choices = species, multiple = T,
options = list(`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
pickerInput(inputId = "width",
label = "Petal Width", selected = width,
choices = width, multiple = T,
options = list(`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
width = 2,
actionButton(inputId = "save", label = "Save"),
actionButton(inputId = "update", label = "Update")
),
mainPanel(
h2("Iris"), fluidRow(
tabPanel("Iris", DT::dataTableOutput("x1"),
width = 12)
)))))
#==========================================SERVER=======================================================#
server <- function(input, output, session) {
SA <- reactive({
df<-df %>%
filter(Species %in% input$species) %>%
filter(Petal.Width %in% input$width)
})
rec_val = reactiveValues(df = NULL)
observe({
rec_val$SA <- SA()
})
output$x1 = renderDT(SA(), selection = 'none', editable = list(target = 'cell', disable = list(columns=c(0,1,2))))
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
rec_val$SA[i, j] <<- DT::coerceValue(v, rec_val$SA[i, j])
replaceData(proxy, rec_val$SA, resetPaging = FALSE)
})
observeEvent(input$save, {
saveRDS(rec_val$SA, "somewhere.rds") # write new data out
})
}
shinyApp(ui = ui, server = server)
编辑:
您需要使用updatePickerInput()
根据编辑更新可用的选项。 此外,定义行 id 以保留修改后的数据。 使用重置您可以返回到原始数据表。 尝试这个
library(shinythemes)
dat <- iris
species <- unique(as.character(dat$Species))
width <- unique(dat$Petal.Width)
#==========================================UI=======================================================#
ui = navbarPage("CSAT & SA", theme = shinytheme("flatly"),
tabPanel("Sentiment Analysis",
sidebarLayout(
sidebarPanel(
pickerInput(inputId = "species",
label = "Species", selected = species,
choices = as.list(species), multiple = T,
options = list(`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
pickerInput(inputId = "width",
label = "Petal Width", selected = width,
choices = as.list(width), multiple = T,
options = list(`actions-box` = TRUE, `deselect-all-text` = "None...",
`select-all-text` = "Select All", `none-selected-text` = "None Selected")),
width = 2,
actionButton(inputId = "save", label = "Save"),
actionButton(inputId = "reset", label = "Reset")
),
mainPanel(
h2("Iris"), fluidRow(
tabPanel("Iris", DT::dataTableOutput("x1"), DTOutput("x2"),
width = 12)
)))))
#==========================================SERVER=======================================================#
server <- function(input, output, session) {
SA <- reactive({
row_id <- c(1:nrow(dat))
data <- data.frame(dat,row_id)
data
})
rv = reactiveValues(df = NULL)
observe({
rv$df <- SA() %>%
filter(Species %in% isolate(input$species)) %>%
filter(Petal.Width %in% isolate(input$width))
})
observeEvent(input$species, {
df1 <- SA() ### orig data
df2 <- rv$df ### modified data
if (is.null(df2)){
rvdf <- SA()
}else{
vn <- colnames(df1)
vnx <- paste0(vn,".x")
vny <- paste0(vn,".y")
rvdf <- left_join(df1, df2, by="row_id") %>% transmute(var1 = get(!!vnx[1]), var2 = get(!!vnx[2]), var3 = get(!!vnx[3]),
var4 = ifelse(is.na(get(!!vny[4])), get(!!vnx[4]), get(!!vny[4])),
var5 = get(!!vnx[5]), # ifelse(is.na(get(!!vny[5])), get(!!vnx[5]), get(!!vny[5])),
row_id)
colnames(rvdf) <- vn
}
rv$df <- rvdf %>%
filter(Species %in% input$species) %>%
filter(Petal.Width %in% input$width)
})
observeEvent(input$width, {
df1 <- SA() ### orig data
df2 <- rv$df ### modified data
if (is.null(df2)){
rvdf <- SA()
}else{
vn <- colnames(df1)
vnx <- paste0(vn,".x")
vny <- paste0(vn,".y")
### keep modified data, if present; if not, keep original data
rvdf <- left_join(df1, df2, by="row_id") %>% transmute(var1 = get(!!vnx[1]), var2 = get(!!vnx[2]), var3 = get(!!vnx[3]),
var4 = ifelse(is.na(get(!!vny[4])), get(!!vnx[4]), get(!!vny[4])), ## keep modified data
var5 = get(!!vnx[5]), # ifelse(is.na(get(!!vny[5])), get(!!vnx[5]), get(!!vny[5])),
row_id)
colnames(rvdf) <- vn
}
rv$df <- rvdf %>%
filter(Species %in% input$species) %>%
filter(Petal.Width %in% input$width)
})
output$x1 <- renderDT(rv$df, selection = 'none',
editable = list(target = 'cell', disable = list(columns=c(0,1,2))),
options = list(
columnDefs = list(
list(
visible = FALSE,
targets = 6
)
)
)
)
proxy <- dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
rv$df[i, j] <<- DT::coerceValue(v, rv$df[i, j])
#replaceData(proxy, rv$df, resetPaging = FALSE)
})
observeEvent(input$save, {
#choicess <- as.list(unique(c(as.character(rv$df[,5]), as.character(SA()[,5]))))
choicesp <- as.list(unique(c(rv$df[,4], SA()[,4])))
# updatePickerInput(session, inputId = "species", choices = choicess, selected=choicess)
updatePickerInput(session, inputId = "width", choices = choicesp, selected=choicesp)
saveRDS(rv$df, "somewhere.rds") # write new data out
df3 <- readRDS("C:/My Disk Space/_My Work/RStuff/GWS/somewhere.rds")
output$x2 <- renderDT({
df3
})
})
observeEvent(input$reset, {
rv$df <- SA()
# choicess <- unique(as.character(rv$df[,5]))
choicesp <- unique(SA()[,4])
# updatePickerInput(session, inputId = "species", choices = choicess, selected=choicess)
updatePickerInput(session, inputId = "width", choices = choicesp, selected=choicesp)
})
}
shinyApp(ui = ui, server = server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.