如何在R shiny中将单个对象的操作按钮合并到一个selectInput()中？

new9mtju 于 2022-12-30 发布在其他

关注(0)|答案(1)|浏览(154)

下面的代码允许用户通过点击操作按钮来添加/删除单独的rhandsontable表以进行数据输入。对于删除，每个表下面都有自己的操作按钮。有什么想法吗？如何将这些删除操作按钮合并到一个selectInput()中，其中列出了所有要删除的表？我尝试过取消嵌套删除函数observeEvent(input[[btnID]]...)，它会触发一个removeUI()，已经有一段时间了但我完全碰壁了。
代码：

library(shiny)
library(rhandsontable)

data1 <- data.frame(row.names = c("A","B","C","Sum"),"Tbl 1"=c(1,1,0,2),check.names=FALSE)

ui <- fluidPage(br(),
  actionButton("addTbl","Add table"),br(),br(),
  tags$div(id="placeholder",tags$div(rHandsontableOutput("hottable1")))
)

server <- function(input, output, session) {
  uiTbl <- reactiveValues(div_01_tbl = data1) 
  rv <- reactiveValues()                
  
  observeEvent(input$hottable1, {uiTbl$div_01_tbl <- hot_to_r(input$hottable1)})
  
  output$hottable1 <- renderRHandsontable({rhandsontable(uiTbl$div_01_tbl, useTypes = TRUE)})
  
  observeEvent(input$addTbl, {
    divID <- paste0("div_", if(input$addTbl+1 < 10){"0"},input$addTbl+1)
    dtID <- paste0(divID, "_DT")
    btnID <- paste0(divID, "_rmv")
    uiTbl[[paste0(divID,"_tbl")]] <- data1 
    
    insertUI(selector = "#placeholder",
      ui = tags$div(id = divID,
        rHandsontableOutput(dtID), 
        actionButton(btnID, "Delete", class = "pull-left btn btn-danger"),
      )
    )
    
    output[[dtID]] <- renderRHandsontable({
      req(uiTbl[[paste0(divID,"_tbl")]])
      rhandsontable(uiTbl[[paste0(divID,"_tbl")]], useTypes = TRUE)
    })
    
    observeEvent(input[[dtID]], {uiTbl[[paste0(divID,"_tbl")]] <- hot_to_r(input[[dtID]])})
    
    observeEvent(input[[btnID]],{
      removeUI(selector = paste0("#", divID))
      rv[[divID]] <- NULL
      uiTbl[[paste0(divID,"_tbl")]] <- NULL
    },
    ignoreInit = TRUE,
    once = TRUE)
  })
  
  observe({
    tables_list <- reactiveValuesToList(uiTbl)
    tables_list <- tables_list[order(names(tables_list))]
    table_lengths <- lengths(tables_list)
    cumsum_table_lengths <- cumsum(table_lengths)[table_lengths != 0L]
    for(i in seq_along(cumsum_table_lengths)){
      names(uiTbl[[names(cumsum_table_lengths[i])]]) <- paste("Col", cumsum_table_lengths[i])
    }
  })
  
}

shinyApp(ui, server)

r

来源：https://stackoverflow.com/questions/74948570/how-to-consolidate-action-buttons-for-individual-objects-into-a-single-selectinp

1条答案

按热度按时间

alen0pnh1#

您可以收集用户的删除选择作为服务器部件中的React值：

deletable_tables <- reactiveVal()

...将选择输入添加到您的UI（我选择了选择输入）

selectizeInput('deletionSelector', 'delete tables:',
                   choices = NULL, multiple = TRUE,
                   options = list(placeholder = 'choose table(s)')
                   )

并在input$addTbl的事件观察器中更新此值：

observeEvent(input$addTbl, {
    ## ...
        deletable_tables(c(deletable_tables(),  dtID))

        updateSelectizeInput(inputId = 'deletionSelector', 
                             session = session, 
                             choices = deletable_tables()
                             )
    ## ...
    }

(note reactiveVal是用参数设置的，而不是通过赋值运算符：my_reactive_val(x)而不是my_reactive_val <- x）

编辑请参阅下面的工作版本。我添加了一个“删除”按钮：当在选择改变时触发删除时，表将被移除，直到不留下任何表为止。

library(shiny)
library(rhandsontable)

data1 <- data.frame(row.names = c("A","B","C","Sum"),"Tbl 1"=c(1,1,0,2),check.names=FALSE)

ui <- fluidPage(
    selectizeInput('deletionSelector', 'delete tables:',
                   choices = NULL, multiple = FALSE,
                   options = list(placeholder = 'choose table(s)')
                   ),
    p(actionButton('deleteTbl', 'delete selection')),
    p(actionButton("addTbl","Add table")),
    tags$div(id="placeholder",tags$div(rHandsontableOutput("hottable1"))),
    )

server <- function(input, output, session) {
    ## store the tables in a list "data" within the
    ## reactive list "ui_tables":
    ui_tables <- reactiveValues(data = list()) 
    delete_ID <- reactiveVal()
    
    ## present initial table on initialisation
    observe({
        ui_tables$data$div_01_tbl <- rhandsontable(data1, useTypes = TRUE)
        output$hottable1 <- renderRHandsontable(ui_tables$data$div_01_tbl)
    }) |> bindEvent('input$addTbl')    

    observeEvent(input$addTbl, {
        divID <- sprintf('div_%02.f', input$addTbl + 1)
        dtID <- paste0(divID, '_tbl')
        ui_tables$data[[dtID]] <- rhandsontable(data1, useTypes = TRUE)
        
        insertUI(selector = "#placeholder",
                 ui = tags$div(id = divID,
                               h4(dtID),
                               rHandsontableOutput(outputId = dtID))
                 )

        output[[dtID]] <- renderRHandsontable({ui_tables$data[[dtID]]})
        
        updateSelectizeInput(
            inputId = 'deletionSelector', 
            session = session, 
            choices = c(dtID, names(ui_tables$data))
        )
    }, ignoreInit = TRUE, ignoreNULL = TRUE)

    observe({        
        delete_ID(input$deletionSelector)
        div_id  = gsub('(div_.*?)_.*$', '\\1', delete_ID())
        removeUI(selector = paste0('#', div_id))
        ui_tables$data[[delete_ID()]] <- NULL
        updateSelectizeInput(inputId = 'deletionSelector', session = session, 
                             choices = names(ui_tables$data)
                             )

    }) |>  bindEvent(input$deleteTbl)

}

shinyApp(ui, server)

赞(0）回复(0）举报 2022-12-30

我来回答

如何在R shiny中将单个对象的操作按钮合并到一个selectInput()中？

1条答案

相关问题

热门标签

最新问答