在 R/Shiny 的引导卡中渲染 DT 数据表

Question

Below is a minimal reproducible example of my problem. What I need to do is render a datatable inside of a bootstrap card. In the example below, the rendering of output$somethingMore does just that. However, in my real world example, I have a slightly more complicated scenario where I cannot pass the data table to the card as I have done there.

Instead, I need to create a table rendered as in my output$brokenIdea example and then take that object and put it inside the card. Of course, my brokenIdea example below is indeed broken, or perhaps even more fallible than that in that's conceptually a bad idea.

However, I am looking to see if there is a solution to this idea so that output$brokenIdea can be created and then passed to the card in a renderUI.

For some context for those who might ask why, this is needed because I have an editable DT table in my real world app and (to my knowledge) being able to edit a data table as in this example here requires an observer paying attention to whether the table outputted in the browser is edited.

My code doesn't have those details in it, but the example above does show the context of the overall situation.

library(shiny)
library(bslib)
library(shinyWidgets)
library(DT)

card <- function(body, title) {
  div(class = "card",
    div(icon("chart-line", style = "color:white"), class = "card-header bg-success text-white text-center font-weight-bold", title),
    div(class = "card-body d-flex justify-content-center", body)
  )
}

ui <- fluidPage(

    navbarPage(
        theme = bs_theme(bootswatch = "flatly", version = 4),
        title = 'Methods',
        tabPanel('One'),
    ),
    mainPanel(
        h1('Hello World'),      
        
    uiOutput('something'),
    br(),
    DTOutput('somethingElse'),
    br(),
    uiOutput('somethingMore'),
    #uiOutput('brokenIdea')
        
    )
)

server <- function(input, output) {

    output$something <- renderUI({
        card('Test', 'Hello')
    })

    output$somethingElse <- renderDT({
        tab <- data.frame(x= rnorm(5), y = rnorm(5))
        DT::datatable(tab)
    })
    
    ### I could do this
    output$somethingMore <- renderUI({
        tab <- data.frame(x= rnorm(5), y = rnorm(5))
        out <- DT::datatable(tab)
        card(out, 'Hi')
    })
    
    ### But what I need is
    output$brokenIdea <- renderUI({
        card(output$somethingElse, 'Can this work')
    })
}

shinyApp(ui, server) 

Answer 1

Put your DTOutput('somethingElse')...) inside renderUI

library(shiny)
library(bslib)
library(shinyWidgets)
library(DT)

card <- function(body, title) {
    div(class = "card",
        div(icon("chart-line", style = "color:white"), class = "card-header bg-success text-white text-center font-weight-bold", title),
        div(class = "card-body d-flex justify-content-center", body)
    )
}

ui <- fluidPage(
    
    navbarPage(
        theme = bs_theme(bootswatch = "flatly", version = 4),
        title = 'Methods',
        tabPanel('One'),
    ),
    mainPanel(
        h1('Hello World'),      
        
        uiOutput('something'),
        br(),
        br(),
        uiOutput('somethingMore'),
        uiOutput('brokenIdea')
        
    )
)

server <- function(input, output) {
    
    output$something <- renderUI({
        card('Test', 'Hello')
    })
    
    tab <- reactive({
        invalidateLater(3000)
        data.frame(x= rnorm(5), y = rnorm(5))
    })
    output$somethingElse <- renderDT({
        DT::datatable(tab())
    })
    
    ### I could do this
    output$somethingMore <- renderUI({
        tab <- data.frame(x= rnorm(5), y = rnorm(5))
        out <- DT::datatable(tab)
        card(out, 'Hi')
    })
    
    ### But what I need is
    output$brokenIdea <- renderUI({
        card(DTOutput('somethingElse'), 'Can this work')
    })
}

shinyApp(ui, server) 

reactive is used in my example to hold the table. To simulate the table changing dynamically, I make it change every 5 seconds.