data.frame中的錯誤：（列表）對象不能被強制鍵入'邏輯'

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))