r - DT::renderTable() 显示“未找到匹配记录”和“显示 0 到 0 个条目（从 x 个总条目过滤）”
问题描述
我正在开发一个应用程序，用户可以在其中选择数据框的列和行以及用于进一步分析的转换方法。按下“应用”按钮后，应显示 3 个表格：
- 包含原始数据的表
- 包含选定原始数据的表
- 具有转换数据的表（未选择的列应完全从分析中排除，行不应显示在转换表中）。
不幸的是，当将列从“cyl”、“disp”、“hp”（3 列）更改为“mpg”、“cyl”、“disp”、“hp”、“drat”（5 列）时，表 2。和 3. 将显示 3 个列标题和“未找到匹配的记录”应该显示行的位置，以及“显示 0 到 0 个条目（从 x 个总条目过滤）”-> 所以没有更新该列标题。
回调下载按钮也无法正常工作。有时它会下载 html 文件或根本不显示。
我在下面放了一个代码示例（尽可能简化）。行按应有的方式显示。可能是因为数据点较少（原始数据帧大约有 100 x 30 000 个数据点）。
library(shiny)
library(DT)
library(shinyWidgets)
library(shinyjs)
transformDataFrame <- function(dataFrame, method = "none") {
transformedSamplesData <- dataFrame[,2:ncol(dataFrame)]
if(method == "none") {
# no transformation
} else if(method == "add1") {
transformedSamplesData <- transformedSamplesData + 1
} else if(method == "add2") {
transformedSamplesData <- transformedSamplesData + 2
} else {
return(NULL)
}
dataFrame[,2:ncol(dataFrame)] <- transformedSamplesData
return(dataFrame)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "selectNormalization", label = "Select normalization",
choices = c("none" = "none",
"Add 1" = "add1",
"Add 2" = "add2"),
selected = "none", multiple = F),
pickerInput(inputId = "selectSamples", label = "Select samples",
choices = NULL, selected = "", multiple = TRUE,
options = list(`live-search`=TRUE,
`actions-box`=TRUE,
`none-selected-text`="No sample selected",
`selected-text-format`="count",
`count-selected-text`="{0} out of {1} samples")),
selectInput(inputId = "selectFilter", label = "Select gene filter",
choices = c("none" = "none",
"Select rows" = "rows"),
selected = "none", multiple = F),
div(actionButton(inputId = "buttonResetFilter", label = "Reset"),
style="display:inline-block"),
span(actionButton(inputId = "buttonApplyFilter", label = "Apply"),
style = "float:right")),
mainPanel(
tabsetPanel(tabPanel("Input data",
#style = 'overflow-x: scroll',
uiOutput("inputUI")),
tabPanel("Filtered raw data",
uiOutput("filteredUI")),
tabPanel("Transformed data",
uiOutput("transformedUI"))))))
server <- function(input, output, session) {
inputData <- reactive({
newCars <- data.frame(rownames(mtcars))
newCars[,2:6] <- data.frame(mtcars[,1:5], row.names = NULL)
names(newCars) <- c("Name", names(mtcars[,1:5]))
sampleNames <- names(newCars)[2:ncol(newCars)]
updatePickerInput(session = session, inputId = "selectSamples",
choices = sampleNames, selected = sampleNames)
return(newCars)
})
userSelection <- dataTableProxy('rawTable')
selectedSamples <- reactive({
sampleColumns <- which(names(inputData()) %in% input$selectSamples)
return(sampleColumns)
})
selectedRows <- reactive({
selectedRows <- input$rawTable_rows_selected
if (length(selectedRows)) {
return(sort(selectedRows))
} else {
return(0)
}
})
selectedGenes <- reactive({
if(length(input$selectSamples)>0) {
if (input$selectFilter=="none") {
numberOfRows <- nrow(inputData())
return(c(1:numberOfRows))
} else if (input$selectFilter=="rows" && (!selectedRows()==0)) {
return(selectedRows())
}
} else { # no samples selected || no file uploaded
return(NULL)
}
})
subsetData <- reactiveValues(rawData = NULL, transformedData = NULL)
observeEvent(input$buttonApplyFilter, {
if(length(input$selectSamples)>0 && length(selectedGenes())>0) {
subsetData$transformedData <- NULL
selectedSamplesData <- inputData()[,c(1, selectedSamples()), drop = FALSE]
transformedSamplesData <- transformDataFrame(selectedSamplesData, input$selectNormalization)
subsetData$rawData <- selectedSamplesData[selectedGenes(), , drop = FALSE]
subsetData$transformedData <- transformedSamplesData[selectedGenes(), , drop = FALSE]
} else {# no samples selected || no file uploaded
subsetData$rawData <- NULL
subsetData$transformedData <- NULL
return(NULL)
}
})
output$rawTable <- DT::renderDataTable({
DT::datatable(inputData(),
extensions=c('Buttons', 'Scroller', 'FixedHeader', 'Responsive', 'ColReorder'),
options=list(lengthMenu = c(25, 50, 100),
pageLength=25,
dom='<"row"<"col-sm-4"l><"col-sm-4"B><"col-sm-4"f>>rtip',
buttons=I('colvis'),
fixedHeader=TRUE,
colReorder=list(realtime=FALSE),
scrollY=500))
})
output$selectedTable <- DT::renderDataTable({
input$buttonApplyFilter
DT::datatable(subsetData$rawData,
selection='none',
callback=JS("$('div.saveSelected').append($('#downloadSelected'));"),
extensions=c('FixedColumns', 'FixedHeader', 'Scroller'), #'Buttons',
options=list(dom='<"row"<"col-sm-8"<"div.saveSelected">><"col-sm-4"f>>rtip',
scrollX=TRUE,
fixedColumns=list(leftColumns=2),
fixedHeader=TRUE,
scrollY=500,
scroller=TRUE))
})
output$transformedTable <- DT::renderDataTable({
input$buttonApplyFilter
DT::datatable(subsetData$transformedData,
selection='none',
callback=JS("$('div.saveTransformed').append($('#downloadTransformed'));"),
extensions=c('FixedColumns', 'FixedHeader', 'Scroller'), #'Buttons',
options=list(dom='<"row"<"col-sm-8"<"div.saveTransformed">><"col-sm-4"f>>rtip',
scrollX=TRUE,
fixedColumns=list(leftColumns=2),
fixedHeader=TRUE,
scrollY=500,
scroller=TRUE))
})
output$inputUI <- renderUI({
tagList(DT::dataTableOutput("rawTable"))
})
output$filteredUI <- renderUI({
tagList(downloadButton(outputId = "downloadSelected", label = "Save table (selected data)"),
DT::dataTableOutput("selectedTable"))
})
output$transformedUI <- renderUI({
tagList(downloadButton(outputId = "downloadTransformed", label = "Save table (transformed data)"),
DT::dataTableOutput("transformedTable"))
})
observeEvent(input$buttonResetFilter, {
updateSelectInput(inputId = "selectNormalization", label = "Select normalization",
choices = c("none" = "none",
"Add 1" = "add1",
"Add 2" = "add2"),
selected = "none", multiple = F)
numberOfCol <- ncol(inputData())
sampleNames <- names(inputData())[2:numberOfCol]
updatePickerInput(session = session, inputId = "selectSamples",
choices = sampleNames, selected = sampleNames)
updateSelectInput(inputId = "selectFilter", label = "Select gene filter",
choices = c("none" = "none",
"Select rows" = "rows"),
selected = "none", multiple = F)
userSelection %>% selectRows(NULL)
subsetData$rawData <- NULL
subsetData$transformedData <- NULL
})
output$downloadSelected <- downloadHandler(
filename = function() {
paste("data_selection_", format(Sys.time(), "%Y-%m-%d-%H%M"), ".csv", sep="")},
content = function(file) {
write.csv(subsetData$rawData, file, row.names=FALSE)},
contentType = "text/csv"
)
output$downloadTransformed <- downloadHandler(
filename = function() {
paste("data_transformation_", format(Sys.time(), "%Y-%m-%d-%H%M"), ".csv", sep="")},
content = function(file) {
write.csv(subsetData$transformedData, file, row.names=FALSE)},
contentType = "text/csv"
)
}
shinyApp(ui, server)
我的第一种方法是将 reactiveValues$x 更改为，subsetDataX <- reactive({ ... })但我不希望每次用户更改输入时都计算这些值。此外，我尝试replace(proxy, data)了，但没有效果。
如果有人知道如何解决这个问题或者可以给我一个提示，我会很高兴。
提前致谢！薇薇安
解决方案
推荐阅读
- mysql - 如何解决 Incorrect string value MySQL 错误？
- sql - 按 1,2,3,4 排序
- r - 在 flexdashboard 闪亮小部件中创建一个依赖于另一个输入变量的输入变量
- sql - 如何在 SQL 中查找字符串中每个字符的计数？
- c++ - 使用 recvfrom 获取数据
- php - Codility 青蛙跳跃
- jquery - Bootstrap 的工具提示需要 Popper.js
- debugging - 错误：预期标识符或 '(' for (int i = 0; i < n; i++)
- c++ - “时间”库形式 Arduino 显示不正确的值
- react-native - CocoaPods 在 react-native-template-typescript 上失败：url_for_request：未初始化的常量 GhInspector::Sidekick::ERB (NameError)