data.frame：（リスト）オブジェクトでエラーが発生しました '論理'を入力できません

Question

d3tableでユーザーが選択した行をshinyjs関数を使用して削除しようとしています。

私がこれまで持っているもののためのコードは以下の通りです：

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