从 R 中的模块的表格中的按钮获取输入

Question

我开始使用 Rhino 处理模块，并且我想在单击表内的按钮时获取输入。

这是创建表格并为每个行项目生成 HTML 按钮的模块。

# app/logic/fluxogramaProcesso.R

box::use(
    glue[glue],
    dplyr[filter, select, mutate],
    reactable[reactable, colDef],
    DBI[dbConnect, dbDisconnect, dbGetQuery],
)

box::use(
    app/logic/connectdb,
    app/logic/funcTrim
)

#' @export
cadastroProdutos <- function() {
    con <- connectdb$create_con()
    
    produtos_query <- glue("SELECT ITEM_CODE FROM TABLE")
    
    produtos_tbl <- dbGetQuery(con, produtos_query) |>
        funcTrim$trimDataChar() |>
        as.data.frame() |>
        mutate(
            view_item = glue::glue('<button class="btn" id="vw_item" onclick="Shiny.onInputChange(\'vw_item\', \'{ITEM_CODE}\')"> <i class="fa-solid fa-eye"></i> </button>')
        ) |>
        reactable(
            columns = list(
                view_item = colDef(html = TRUE)
            )
        )
    
    dbDisconnect(con)
    
    return(produtos_tbl)
}

**该模块生成的表，转到生成该表的服务器和ui的模块。 **

# app/view/table.R

box::use(
    reactable[reactableOutput, renderReactable],
    shiny[moduleServer, NS, observeEvent],
)

#' @export
ui <- function(id) {
    ns <- NS(id)
    reactableOutput(ns("table"))
}


#' @export
server <- function(id, data) {
    moduleServer(id, function(input, output, session){
        output$table <- renderReactable({
            data()
        })
    })
}

然后最后去我的主站。R

# app/main.R

box::use(
    shiny[bootstrapPage, moduleServer, NS, reactive, icon, textInput, renderText, observeEvent, showModal, modalDialog],
    shinydashboard[dashboardPage, dashboardHeader, dashboardBody, dashboardSidebar, sidebarMenu, menuItem, tabItems, tabItem],
)

box::use(
    app/view/table,
    app/view/dataTable,
    app/logic/dataProduct,
    app/logic/fluxogramaProcesso,
    app/logic/cadastroProdutos,
)

#' @export
ui <- function(id) {
    ns <- NS(id)
    
    dashboardPage(
        dashboardHeader(),
        
        dashboardSidebar(
            sidebarMenu(
                menuItem("Fluxograma  de Processos", 
                         tabName = "fluxproc",
                         icon = icon("sitemap"))
            )
        ),
        
        dashboardBody(
            tabItems(
                tabItem(tabName  = "fluxproc",
          
                        table$ui(ns("cadastroProd"))
                        )
            )
        )
    )
}

#' @export
server <- function(id) {
    moduleServer(id, function(input, output, session) {
        
        dataProdutos <- reactive(cadastroProdutos$cadastroProdutos())
        table$server("cadastroProd", dataProdutos)
        
        observeEvent(input$vw_item, {
            showModal(
                modalDialog(
                    h2("IT WORKS !!!!")
                )
            )
        }
        )
    })
}

我想当单击桌子上的按钮时，它会生成一个 showModal。我无法从按钮检索输入。

Answer 1

我对Rhino和box不熟悉，所以我对自己不太确定。

这是一个服务器模块：

server <- function(id) {
    moduleServer(id, function(input, output, session) {
        
        dataProdutos <- reactive(cadastroProdutos$cadastroProdutos())
        table$server("cadastroProd", dataProdutos)
        
        observeEvent(input$vw_item, {
            showModal(
                modalDialog(
                    h2("IT WORKS !!!!")
                )
            )
        }
        )
    })
}

因此，如果我没有记错的话，观察者实际上会听到

input[[ns("vw_item")]]

，然后按钮单击将永远不会被检测到，因为它会触发

Shiny.onInputChange("vw_item"

。

所以我会尝试：

cadastroProdutos <- function(ns) { # add ns argument
    con <- connectdb$create_con()
    
    produtos_query <- glue("SELECT ITEM_CODE FROM TABLE")
    
    ID <- ns("vw_item") # the name of the Shiny value sent on click

    produtos_tbl <- dbGetQuery(con, produtos_query) |>
        funcTrim$trimDataChar() |>
        as.data.frame() |>
        mutate( # send input[[ID]] on click
            view_item = glue::glue('<button class="btn" id="vw_item" onclick="Shiny.onInputChange(\'{ID}\', \'{ITEM_CODE}\')"> <i class="fa-solid fa-eye"></i> </button>')
        ) |>
        reactable(
            columns = list(
                view_item = colDef(html = TRUE)
            )
        )
    
    dbDisconnect(con)
    
    return(produtos_tbl)
}

和：

server <- function(id) {
    moduleServer(id, function(input, output, session) {
        ns <- session$ns
        
        dataProdutos <- reactive(cadastroProdutos$cadastroProdutos(ns)) # added ns
        table$server("cadastroProd", dataProdutos)
        
        observeEvent(input$vw_item, {
            showModal(
                modalDialog(
                    h2("IT WORKS !!!!")
                )
            )
        }
        )
    })
}

---

编辑：可能的替代方案

一个可能的替代方案是使用 reactable.extras 包来制作按钮。不幸的是，我无法在这些按钮内渲染图标（但我在 reactable.extras Github 存储库上提出了关于此问题的问题）。

library(shiny)
library(reactable)
library(reactable.extras)

df <- MASS::Cars93[, 1:4]
df$view_item <- "click"

mod_ui <- function(id) {
  ns <- NS(id)
  reactableOutput(ns("table"))
}

mod_server <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      
      ns <- session$ns
      
      output$table <- renderReactable({
        reactable(
          df,
          columns = list(
            view_item = colDef(
              cell = button_extra(id = ns("button"), class = "button-extra")
            )
          )
        )
      })
      
      item <- eventReactive(input$button, {
        df$Manufacturer[input$button$row]
      })
      
      return(item)
    }
  )
}

ui <- fluidPage(
  reactable_extras_dependency(),
  mod_ui("x")
)


server <- function(input, output, session) {

  x <- mod_server("x")
  
  observe({
    print(x())
  })
  
}

shinyApp(ui, server)