防止数据表页面在删除行后跳转到第1页

问题描述 投票：0回答：1

我在 Shiny 应用程序中的 DataTables 包中遇到了 renderDT 问题。有时，我需要从表中删除一行或多行。虽然有一个有用的行删除示例（https://github.com/stefaneng/Shiny-DeleteRowsDT/blob/master/app.R），我将其用作起点，但我发现当删除一行时，renderDT 会导致应用程序跳回第一页，当有多个页面时，这可能会造成破坏。

我尝试按照这篇post中的建议使用DT::replaceData，但它没有按我的预期工作，可能是因为表尺寸受到了影响。

我使用了下面的解决方案（受此post启发），该解决方案涉及在 renderDT 之后运行 selectPage。然而，该解决方案似乎在 70% 的情况下都有效。知道为什么以及如何改进吗？

library(shiny)
library(DT)

ui <- fluidPage(
  titlePanel("Delete rows"),
  mainPanel(
    selectInput('datasetSelect',
                label = 'Select data',
                choices = c("mtcars", "iris", "faithful")),
    uiOutput('undoUI'),
    DT::dataTableOutput("dtable")
  )
)

server <- function(input, output) {
  rv <- reactiveValues(
    data = NULL,
    deletedRows = NULL,
    deletedRowIndices = list()
  )
  
  pageNumber <- reactiveVal(1)

  observeEvent(input$datasetSelect, {
    rv$data <- switch (input$datasetSelect,
                       "mtcars" = mtcars,
                       "iris" = iris,
                       "faithful" = faithful
    )
    
    # Clear the previous deletions
    rv$deletedRows <- NULL
    rv$deletedRowIndices = list()
  })
  
  observeEvent(input$deletePressed, {
    rowNum <- parseDeleteEvent(input$deletePressed)
    dataRow <- rv$data[rowNum,]
    
    # Put the deleted row into a data frame so we can undo
    # Last item deleted is in position 1
    rv$deletedRows <- rbind(dataRow, rv$deletedRows)
    rv$deletedRowIndices <- append(rv$deletedRowIndices, rowNum, after = 0)
            
    # Delete the row from the data frame
    rv$data <- rv$data[-rowNum,, drop = FALSE]

    # On last page and removing the only remaining row?
last_element <- input$dtable_row_last_clicked %% input$dtable_state$length == 1 
last_page <- input$dtable_row_last_clicked == max(input$dtable_rows_all)

    # Add = 1 if the number of page is not affected by the deletion
    add <- ifelse(last_element && last_page, 0, 1)
    pageNumber(input$dtable_state$start/input$dtable_state$length+add) # set
    
    output$dtable <- DT::renderDT(deleteButtonColumn(isolate(rv$data), 'delete_button'))
  })
  
  # Set the page
  observeEvent (input$dtable_cell_clicked, {
    proxy <- DT::dataTableProxy('dtable')
    selectPage(proxy, pageNumber())
  })  

  observeEvent(input$undo, {
    if(nrow(rv$deletedRows) > 0) {
      row <- rv$deletedRows[1, ]
      rv$data <- addRowAt(rv$data, row, rv$deletedRowIndices[[1]])
      
      # Remove row
      rv$deletedRows <- rv$deletedRows[-1,]
      # Remove index
      rv$deletedRowIndices <- rv$deletedRowIndices[-1]
    }
  })
  
  # Disable the undo button if we have not deleted anything
  output$undoUI <- renderUI({
    if(!is.null(rv$deletedRows) && nrow(rv$deletedRows) > 0) {
      actionButton('undo', label = 'Undo delete', icon('undo'))
    } else {
      actionButton('undo', label = 'Undo delete', icon('undo'), disabled = TRUE)
    }
  })
  
  output$dtable <- DT::renderDT(
    # Add the delete button column
    isolate(deleteButtonColumn(rv$data, 'delete_button'))
  )
}

#' Adds a row at a specified index
#'
#' @param df a data frame
#' @param row a row with the same columns as \code{df}
#' @param i the index we want to add row at.
#' @return the data frame with \code{row} added to \code{df} at index \code{i}
addRowAt <- function(df, row, i) {
  # Slow but easy to understand
  if (i > 1) {
    rbind(df[1:(i - 1), ], row, df[-(1:(i - 1)), ])
  } else {
    rbind(row, df)
  }
  
}

#' A column of delete buttons for each row in the data frame for the first column
#'
#' @param df data frame
#' @param id id prefix to add to each actionButton. The buttons will be id'd as id_INDEX.
#' @return A DT::datatable with escaping turned off that has the delete buttons in the first column and \code{df} in the other
deleteButtonColumn <- function(df, id, ...) {
  # function to create one action button as string
  f <- function(i) {
    # https://shiny.rstudio.com/articles/communicating-with-js.html
    as.character(actionButton(paste(id, i, sep="_"), label = NULL, icon = icon('trash'),
                              onclick = 'Shiny.setInputValue(\"deletePressed\",  this.id, {priority: "event"})'))
  }
  
  deleteCol <- unlist(lapply(seq_len(nrow(df)), f))
  
  # Return a data table
  DT::datatable(cbind(delete = deleteCol, df),
                # Need to disable escaping for html as string to work
                escape = FALSE,
                editable = TRUE,
                options = list(pageLength  = 5,
                  # Disable sorting for the delete column
                  columnDefs = list(list(targets = 1, sortable = FALSE))
                ))
  
  
}

#' Extracts the row id number from the id string
#' @param idstr the id string formated as id_INDEX
#' @return INDEX from the id string id_INDEX
parseDeleteEvent <- function(idstr) {
  res <- as.integer(sub(".*_([0-9]+)", "\\1", idstr))
  if (! is.na(res)) res
}

# Run the application
shinyApp(ui = ui, server = server)
r shiny dt
1个回答
0
投票

对观察者事件使用不同的触发器似乎就足够了。

  # Set the page
  observeEvent (input$dtable_rows_all, {
    proxy <- DT::dataTableProxy('dtable')
    selectPage(proxy, pageNumber())
  })

我对表格进行了多次修改，所以最后我使用了类似于下面代码的内容：

library(shiny)
library(DT)

ui <- fluidPage(
  titlePanel("Delete rows"),
  mainPanel(
    selectInput('datasetSelect',
                label = 'Select data',
                choices = c("mtcars", "iris", "faithful")),
    uiOutput('undoUI'),
    DT::dataTableOutput("dtable")
  )
)

server <- function(input, output) {
  rv <- reactiveValues(
    data = NULL,
    deletedRows = NULL,
    deletedRowIndices = list()
  )
  
  pageNumber <- reactiveVal(1)
  trigger <- reactiveVal(0)
  
  observeEvent(input$datasetSelect, {
    rv$data <- switch (input$datasetSelect,
                       "mtcars" = mtcars,
                       "iris" = iris,
                       "faithful" = faithful
    )
    
    # Clear the previous deletions
    rv$deletedRows <- NULL
    rv$deletedRowIndices = list()
  })
  
  observeEvent(input$deletePressed, {
    rowNum <- parseDeleteEvent(input$deletePressed)
    dataRow <- rv$data[rowNum,]
    
    # Put the deleted row into a data frame so we can undo
    # Last item deleted is in position 1
    rv$deletedRows <- rbind(dataRow, rv$deletedRows)
    rv$deletedRowIndices <- append(rv$deletedRowIndices, rowNum, after = 0)
    
    # Delete the row from the data frame
    rv$data <- rv$data[-rowNum,, drop = FALSE]
    
    # On last page and removing the only remaining row?
    last_element <- input$dtable_row_last_clicked %% input$dtable_state$length == 1 
    last_page <- input$dtable_row_last_clicked == max(input$dtable_rows_all)
    
    # Add = 1 if the number of page is not affected by the deletion
    add <- ifelse(last_element && last_page, 0, 1) #
    pageNumber(input$dtable_state$start/input$dtable_state$length+add) # set
    
    trigger(trigger() + 1)
  })

  # Set the page
  observeEvent (trigger(), {
    output$dtable <- DT::renderDT(isolate(deleteButtonColumn(rv$data, 'delete_button')), server = TRUE)
  })
    
  # Set the page
  observeEvent (input$dtable_rows_all, {
    proxy <- DT::dataTableProxy('dtable')
    # browser()
    # input$dtable_rows_selected
    # input$dtable_cells_selected
    # input$dtable_rows_all
    selectPage(proxy, pageNumber())
  })  

  observeEvent(input$undo, {
    if(nrow(rv$deletedRows) > 0) {
      row <- rv$deletedRows[1, ]
      rv$data <- addRowAt(rv$data, row, rv$deletedRowIndices[[1]])
      
      # Remove row
      rv$deletedRows <- rv$deletedRows[-1,]
      # Remove index
      rv$deletedRowIndices <- rv$deletedRowIndices[-1]
    }
  })
  
  # Disable the undo button if we have not deleted anything
  output$undoUI <- renderUI({
    if(!is.null(rv$deletedRows) && nrow(rv$deletedRows) > 0) {
      actionButton('undo', label = 'Undo delete', icon('undo'))
    } else {
      actionButton('undo', label = 'Undo delete', icon('undo'), disabled = TRUE)
    }
  })
  
  output$dtable <- DT::renderDT(
    # Add the delete button column
    isolate(deleteButtonColumn(rv$data, 'delete_button'))
  )
}

#' Adds a row at a specified index
#'
#' @param df a data frame
#' @param row a row with the same columns as \code{df}
#' @param i the index we want to add row at.
#' @return the data frame with \code{row} added to \code{df} at index \code{i}
addRowAt <- function(df, row, i) {
  # Slow but easy to understand
  if (i > 1) {
    rbind(df[1:(i - 1), ], row, df[-(1:(i - 1)), ])
  } else {
    rbind(row, df)
  }
  
}

#' A column of delete buttons for each row in the data frame for the first column
#'
#' @param df data frame
#' @param id id prefix to add to each actionButton. The buttons will be id'd as id_INDEX.
#' @return A DT::datatable with escaping turned off that has the delete buttons in the first column and \code{df} in the other
deleteButtonColumn <- function(df, id, ...) {
  # function to create one action button as string
  f <- function(i) {
    # https://shiny.rstudio.com/articles/communicating-with-js.html
    as.character(actionButton(paste(id, i, sep="_"), label = NULL, icon = icon('trash'),
                              onclick = 'Shiny.setInputValue(\"deletePressed\",  this.id, {priority: "event"})'))
  }
  
  deleteCol <- unlist(lapply(seq_len(nrow(df)), f))
  
  # Return a data table
  DT::datatable(cbind(delete = deleteCol, df),
                # Need to disable escaping for html as string to work
                escape = FALSE,
                editable = TRUE,
                options = list(pageLength  = 5,
                  # Disable sorting for the delete column
                  columnDefs = list(list(targets = 1, sortable = FALSE, stateSave = TRUE))
                ))
  
  
}

#' Extracts the row id number from the id string
#' @param idstr the id string formated as id_INDEX
#' @return INDEX from the id string id_INDEX
parseDeleteEvent <- function(idstr) {
  res <- as.integer(sub(".*_([0-9]+)", "\\1", idstr))
  if (! is.na(res)) res
}

# Run the application
shinyApp(ui = ui, server = server)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.