Question

我正在尝试使用shinyjs函数删除用户在d3table上选择的行。

到目前为止我的代码如下：

library(shiny)
library(htmlwidgets)
library(D3TableFilter)
data(mtcars)

mtcars2 <- mtcars[,1:2]

GetTableMetadata <- function() {
  fields <- c(mpg = "mpg", 
              cyl = "cyl" )
  result <- list(fields = fields)
  return (result)
}

#R
ReadData <- function() {
  if (exists("mtcars2")) {
    mtcars2
  }
}

#D
DeleteData <- function(data) {
  mtcars2 <- mtcars2[row.names(mtcars2) != unname(data["mpg"]), ]
}

UpdateInputs <- function(data, session) {
  updateTextInput(session, "mpg", value = unname(rownames(data)))
  updateTextInput(session, "cyl", value = unname(data["name"]))
 }


CreateDefaultRecord <- function() {
  mydefault <- CastData(list(mpg = "", cyl = ""))
  return (mydefault)
}

# ui.R
# --------------------------------------------------------
ui <- shinyUI(fluidPage(
  title = 'Interactive features',
  tabsetPanel(

    tabPanel("Row selection",
             fluidRow(column(width = 12, h4("Row selection"))),
             fluidRow(
               column(width = 2,

                      wellPanel(
                        actionButton("delete", "Delete")
                      )
                     ),
               column(width = 5,
                      d3tfOutput('mtcars2', height = "2000px")
                      ),
               column(width = 5,
                      tableOutput("mtcars2Output")
                      )

                 )
    ) 
  )))

# server.R
# --------------------------------------------------------
server <- shinyServer(function(input, output, session) {

  formData <- reactive({
    sapply(names(GetTableMetadata()$fields), function(x) input[[x]])
  })

  # Press "Delete" button -> delete from data
  observeEvent(input$delete, {
    DeleteData(formData())
    UpdateInputs(CreateDefaultRecord(), session)
  }, priority = 1)


   output$mtcars2 <- renderD3tf({
    input$delete
    ReadData()

    # define table properties. See http://tablefilter.free.fr/doc.php

    tableProps <- list(
      btn_reset = TRUE,
      rows_counter = TRUE,  
      rows_counter_text = "Rows: ",
      sort = TRUE,
      on_keyup = TRUE,  
      on_keyup_delay = 800,
      filters_row_index = 1
      );


    d3tf(mtcars[ , 1:2],
         enableTf = TRUE,
         tableProps = tableProps,
         showRowNames = FALSE, 
         selectableRows = "multi",
         selectableRowsClass = "info",
         tableStyle = "table table-bordered table-condensed",
         rowStyles = c(rep("", 7), rep("info", 7)),
         filterInput = TRUE,
         height = 500);
      })

   output$mtcars2Output <- renderTable({
    if(is.null(input$mtcars2_select)) return(NULL);
    mtcars2[input$mtcars2_select,1:2];
  })


})

runApp(list(ui=ui,server=server))

当我选择一行并点击Delete按钮时，我收到错误

Error in data.frame: (list) object cannot be coerced to type 'logical'

感谢任何帮助。

Answer 1

请参阅我的一些问题的评论，但这可以使用reactiveValues吗？

library(shiny)
library(htmlwidgets)
library(D3TableFilter)
data(mtcars)

mtcars2 <- mtcars[,1:2]

GetTableMetadata <- function() {
  fields <- c(mpg = "mpg", 
              cyl = "cyl" )
  result <- list(fields = fields)
  return (result)
}

#R
ReadData <- function() {
  if (exists("mtcars2")) {
    mtcars2
  }
}

#D
DeleteData <- function(data) {
  mtcars2 <- mtcars2[row.names(mtcars2) != unname(data["mpg"]), ]
}

UpdateInputs <- function(data, session) {
  updateTextInput(session, "mpg", value = unname(rownames(data)))
  updateTextInput(session, "cyl", value = unname(data["name"]))
}


CreateDefaultRecord <- function() {
  mydefault <- CastData(list(mpg = "", cyl = ""))
  return (mydefault)
}

# ui.R
# --------------------------------------------------------
ui <- shinyUI(fluidPage(
  title = 'Interactive features',
  tabsetPanel(

    tabPanel("Row selection",
             fluidRow(column(width = 12, h4("Row selection"))),
             fluidRow(
               column(width = 2,

                      wellPanel(
                        actionButton("delete", "Delete")
                      )
               ),
               column(width = 5,
                      d3tfOutput('mtcars2', height = "2000px")
               ),
               column(width = 5,
                      tableOutput("mtcars2Output")
               )

             )
    ) 
  )))

# server.R
# --------------------------------------------------------
server <- shinyServer(function(input, output, session) {

  values <- reactiveValues(data=ReadData())

  # Press "Delete" button -> delete from data
  observeEvent(input$delete, {
    values$data <- values$data[-input$mtcars2_select,]
  }, priority = 1)


  output$mtcars2 <- renderD3tf({
    # define table properties. See http://tablefilter.free.fr/doc.php

    tableProps <- list(
      btn_reset = TRUE,
      rows_counter = TRUE,  
      rows_counter_text = "Rows: ",
      sort = TRUE,
      on_keyup = TRUE,  
      on_keyup_delay = 800,
      filters_row_index = 1
    );


    d3tf(values$data,
         enableTf = TRUE,
         tableProps = tableProps,
         showRowNames = FALSE, 
         selectableRows = "multi",
         selectableRowsClass = "info",
         tableStyle = "table table-bordered table-condensed",
         rowStyles = c(rep("", 7), rep("info", 7)),
         filterInput = TRUE,
         height = 500);
  })

  output$mtcars2Output <- renderTable({
    if(is.null(input$mtcars2_select)) return(NULL);
    mtcars2[input$mtcars2_select,1:2];
  })


})

runApp(list(ui=ui,server=server))

data.frame中的错误:( list）对象无法强制键入'logical'

1 个答案: