我使用DT软件包在R Shiny应用程序中有一个数据表。该表已启用列过滤器。有时，我将使用replaceData函数替换数据表中的数据。发生这种情况时，数据会更新，但列过滤器中的选择仍会反映原始数据的选择。
在下面的示例中，初始数据具有三行，可以使用任何列过滤器将每一行过滤为该行。单击“更新数据”按钮会将数据替换为相同的数据，再加上一行。您可以看到NUMERIC列的选择仍然仅是1到3，而不是1到4，而FACTOR列的选择仍然只给出了“ A”，“ B”和“ C”作为选择，但不包括“ D”。
根据replaceData函数的文档，“启用列过滤器后，还应确保每个列的属性保持相同，例如，因子列应具有相同或更少的级别，数字列应具有相同或较小的范围，否则过滤器可能永远无法到达数据中的某些行。”因此，这是预期的行为，但我想知道是否还有办法更新列过滤器中的选择。我假设没有使用R的解决方案，但我希望有可以使用的javascript解决方案。我不太了解javascript，因此最初看不到DT包如何生成列选择，但是如果可能的话，我确实知道如何从闪亮的应用程序中调用javascript代码。如果没有办法，那么我的最后一招就是在每次我要替换数据时仅重新渲染数据表，但是如果不需要的话，我宁愿不这样做。
library(shiny)
library(DT)
ui <- fluidPage(
fluidRow(DTOutput("table")),
fluidRow(actionButton("replace", "Replace Data"))
)
server <- function(input, output, session) {
output$table <- renderDT({
data <- data.frame(NUMERIC = c(1, 2, 3), FACTOR = as.factor(c("A", "B", "C")), TEXT = c("A1", "B2", "C3"), stringsAsFactors = FALSE)
datatable(data, filter = list(position = "top"))
})
observeEvent(input$replace, {
data <- data.frame(NUMERIC = c(1, 2, 3, 4), FACTOR = as.factor(c("A", "B", "C", "D")), TEXT = c("A1", "B2", "C3", "D4"), stringsAsFactors = FALSE)
replaceData(proxy = dataTableProxy("table"), data = data)
})
}
shinyApp(ui = ui, server = server)
答案 0 :(得分：0)
从?replaceData中可以看到：
当替换现有表中的数据时，请确保 新数据的列数与当前数据相同。当你 已启用列过滤器，还应确保属性 每列的保持不变，例如因子列应具有 相同或更少的级别，并且数字列应具有相同或 范围较小，否则过滤器可能永远无法达到 数据中的某些行。
这意味着您只能获得较小的过滤器，而不能获得较大的过滤器。
好吧，这不是干净的，而是肮脏的把戏：
如果您使用trace(datatable, edit=T)，则可以修改函数datatable，以便用原始代码代替：
function (data, options = list(), class = "display", callback = JS("return table;"),
rownames, colnames, container, caption = NULL, filter = c("none",
"bottom", "top"), escape = TRUE, style = "default",
width = NULL, height = NULL, elementId = NULL, fillContainer = getOption("DT.fillContainer",
NULL), autoHideNavigation = getOption("DT.autoHideNavigation",
NULL), selection = c("multiple", "single", "none"),
extensions = list(), plugins = NULL, editable = FALSE)
{
datafull = data[[2]]
data = data[[1]]
oop = base::options(stringsAsFactors = FALSE)
on.exit(base::options(oop), add = TRUE)
options = modifyList(getOption("DT.options", list()), if (is.function(options))
options()
else options)
params = list()
if (crosstalk::is.SharedData(data)) {
params$crosstalkOptions = list(key = data$key(), group = data$groupName())
data = data$data(withSelection = FALSE, withFilter = TRUE,
withKey = FALSE)
datafull = data$data(withSelection = FALSE, withFilter = TRUE,
withKey = FALSE)
}
rn = if (missing(rownames) || isTRUE(rownames))
base::rownames(data)
else {
if (is.character(rownames))
rownames
}
hideDataTable = FALSE
if (is.null(data) || identical(ncol(data), 0L)) {
data = matrix(ncol = 0, nrow = NROW(data))
datafull = matrix(ncol = 0, nrow = NROW(datafull))
hideDataTable = TRUE
}
else if (length(dim(data)) != 2) {
str(data)
stop("'data' must be 2-dimensional (e.g. data frame or matrix)")
}
if (is.data.frame(data)) {
data = as.data.frame(data)
numc = unname(which(vapply(data, is.numeric, logical(1))))
}
else {
if (!is.matrix(data))
stop("'data' must be either a matrix or a data frame, and cannot be ",
classes(data), " (you may need to coerce it to matrix or data frame)")
numc = if (is.numeric(data))
seq_len(ncol(data))
data = as.data.frame(data)
}
if (!is.null(rn)) {
data = cbind(` ` = rn, data)
datafull = cbind(` ` = rn, datafull)
numc = numc + 1
}
if (length(numc)) {
undefined_numc = setdiff(numc - 1, classNameDefinedColumns(options))
if (length(undefined_numc))
options = appendColumnDefs(options, list(className = "dt-right",
targets = undefined_numc))
}
if (is.null(options[["order"]]))
options$order = list()
if (is.null(options[["autoWidth"]]))
options$autoWidth = FALSE
if (is.null(options[["orderClasses"]]))
options$orderClasses = FALSE
cn = base::colnames(data)
if (missing(colnames)) {
colnames = cn
}
else if (!is.null(names(colnames))) {
i = convertIdx(colnames, cn)
cn[i] = names(colnames)
colnames = cn
}
if (ncol(data) - length(colnames) == 1)
colnames = c(" ", colnames)
if (length(colnames) && colnames[1] == " ")
options = appendColumnDefs(options, list(orderable = FALSE,
targets = 0))
style = match.arg(tolower(style), DTStyles())
if (style == "bootstrap")
class = DT2BSClass(class)
if (style != "default")
params$style = style
if (isTRUE(fillContainer))
class = paste(class, "fill-container")
if (is.character(filter))
filter = list(position = match.arg(filter))
filter = modifyList(list(position = "none", clear = TRUE,
plain = FALSE), filter)
filterHTML = as.character(filterRow(datafull, !is.null(rn) &&
colnames[1] == " ", filter))
if (filter$position == "top")
options$orderCellsTop = TRUE
params$filter = filter$position
if (filter$position != "none")
params$filterHTML = filterHTML
if (missing(container)) {
container = tags$table(tableHeader(colnames, escape),
class = class)
}
else {
params$class = class
}
attr(options, "escapeIdx") = escapeToConfig(escape, colnames)
if (is.list(extensions)) {
extensions = names(extensions)
}
else if (!is.character(extensions)) {
stop("'extensions' must be either a character vector or a named list")
}
params$extensions = if (length(extensions))
as.list(extensions)
if ("Responsive" %in% extensions)
options$responsive = TRUE
params$caption = captionString(caption)
if (editable)
params$editable = editable
if (!identical(class(callback), class(JS(""))))
stop("The 'callback' argument only accept a value returned from JS()")
if (length(options$pageLength) && length(options$lengthMenu) ==
0) {
if (!isFALSE(options$lengthChange))
options$lengthMenu = sort(unique(c(options$pageLength,
10, 25, 50, 100)))
if (identical(options$lengthMenu, c(10, 25, 50, 100)))
options$lengthMenu = NULL
}
if (!is.null(fillContainer))
params$fillContainer = fillContainer
if (!is.null(autoHideNavigation))
params$autoHideNavigation = autoHideNavigation
params = structure(modifyList(params, list(data = data,
container = as.character(container), options = options,
callback = if (!missing(callback)) JS("function(table) {",
callback, "}"))), colnames = cn, rownames = length(rn) >
0)
if (inShiny() || length(params$crosstalkOptions)) {
if (is.character(selection)) {
selection = list(mode = match.arg(selection))
}
selection = modifyList(list(mode = "multiple", selected = NULL,
target = "row"), selection)
if (grepl("^row", selection$target) && is.character(selection$selected) &&
length(rn)) {
selection$selected = match(selection$selected, rn)
}
params$selection = selection
}
deps = list(DTDependency(style))
deps = c(deps, unlist(lapply(extensions, extDependency,
style, options), recursive = FALSE))
if (params$filter != "none")
deps = c(deps, filterDependencies())
if (isTRUE(options$searchHighlight))
deps = c(deps, list(pluginDependency("searchHighlight")))
if (length(plugins))
deps = c(deps, lapply(plugins, pluginDependency))
deps = c(deps, crosstalk::crosstalkLibs())
if (isTRUE(fillContainer)) {
width = NULL
height = NULL
}
htmlwidgets::createWidget("datatables", if (hideDataTable)
NULL
else params, package = "DT", width = width, height = height,
elementId = elementId, sizingPolicy = htmlwidgets::sizingPolicy(knitr.figure = FALSE,
knitr.defaultWidth = "100%", knitr.defaultHeight = "auto"),
dependencies = deps, preRenderHook = function(instance) {
data = instance[["x"]][["data"]]
if (object.size(data) > 1500000 && getOption("DT.warn.size",
TRUE))
warning("It seems your data is too big for client-side DataTables. You may ",
"consider server-side processing: https://rstudio.github.io/DT/server.html")
data = escapeData(data, escape, colnames)
data = unname(data)
instance$x$data = data
instance
})
}
保存后，您可以看到这样做：
library(shiny)
library(data.table)
library(DT)
ui <- fluidPage(
fluidRow(DTOutput("table")),
fluidRow(actionButton("replace", "Replace Data"))
)
server <- function(input, output, session) {
output$table <- renderDT({
data <- data.table(NUMERIC = c(1, 2, 3), FACTOR = as.factor(c("A", "B", "C")), TEXT = c("A1", "B2", "C3"), stringsAsFactors = FALSE)
datafull <- data.table(NUMERIC = c(1, 2, 3, 4), FACTOR = as.factor(c("A", "B", "C", "D")), TEXT = c("A1", "B2", "C3", "D4"), stringsAsFactors = FALSE)
datatable(list(data,datafull), filter = list(position = "top"))
})
observeEvent(input$replace, {
data <- data.frame(NUMERIC = c(1, 2, 3, 4), FACTOR = as.factor(c("A", "B", "C", "D")), TEXT = c("A1", "B2", "C3", "D4"), stringsAsFactors = FALSE)
replaceData(proxy = dataTableProxy("table"), data = data)
})
}
shinyApp(ui = ui, server = server)
您看到可以从头开始过滤D和4。
我知道这是一件很棘手的事情。求求你，不要严厉地评判我...