Fehler in data.frame: (list) -Objekt kann nicht gezwungen werden, 'logical' einzugeben

Question

Ich versuche eine Zeile zu löschen, die vom Benutzer auf einer d3table mit shinyjs-Funktionen ausgewählt wurde.

Der Code für das, was ich bisher habe, ist wie folgt:

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

Wenn ich eine Zeile auswählen und klicken Sie auf die Delete Taste, ich bin

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

Jede mögliche Hilfe schätzen einen Fehler bekommen .

Answer 1

Siehe Kommentare für einige Fragen, die ich habe, aber würde dies mit reactiveValues arbeiten?

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