bslib::value_box within bs4Dash displays not as intended

I am trying to adapt for my own application the last example in this documentation of creating valueBoxes with "showcase"d sparklines made interactive via plotly. The example does not go as far as rendering within a shiny app and the bslib package does not include render/output functions.

I have gotten something sort of working via the renderUI/uiOutput functions but the result does not respect proportioning and positioning between the value and the showcased sparkline within the bs4Dash (or any other framework). Running the code interactively in RStudio shows the desired result in the Viewer pane. I am looking for help to match the rendered output in my shiny app to the article linked above

MRE below

## app.R ##
library(shiny)
library(plotly)
library(dplyr)
library(bs4Dash)
library(bslib)


ui <- bs4DashPage(
  dashboardHeader(title = "Test Dash"),
  bs4DashSidebar(
    sidebarMenu(id = "tab",
                menuItem("Test 1", tabName = "t1", icon = icon("dashboard")),
                menuItem("Test 2", tabName = "t2", icon = icon("triangle-exclamation"))
    )
  ),
  bs4DashBody(
    tabItems(
      tabItem(tabName = "t1",
              
              fluidRow(
                box(width = 3,
                    uiOutput("papq_vbox_quote")
                )
              )               
      ),
      tabItem(tabName = "t2"
      )
    )
  )
)

server <- function(input, output) {
  
  dat <- tibble(Date = seq(Sys.Date()-59, Sys.Date(), by = 1),
                measure = rnorm(length(Date), 20 + (Date - min(Date)), 5))
  
  output$papq_vbox_quote <- renderUI({
    
    sparkline <- plot_ly(dat) %>%
      add_lines(
        x = ~Date, y = ~measure,
        color = I("white"), span = I(1),
        fill = 'tozeroy', alpha = 0.2
      ) %>%
      layout(
        xaxis = list(visible = F, showgrid = F, title = ""),
        yaxis = list(visible = F, showgrid = F, title = ""),
        hovermode = "x",
        margin = list(t = 0, r = 0, l = 0, b = 0),
        font = list(color = "white"),
        paper_bgcolor = "transparent",
        plot_bgcolor = "transparent"
      ) %>%
      config(displayModeBar = F) %>%
      htmlwidgets::onRender(
        "function(el) {
      var ro = new ResizeObserver(function() {
         var visible = el.offsetHeight > 200;
         Plotly.relayout(el, {'xaxis.visible': visible});
      });
      ro.observe(el);
    }"
      )
    
    value_box("Series Data",
              value = formatC(mean(dat$measure), format = "d", big.mark = ","),
              showcase = sparkline,
              showcase_layout = showcase_left_center(),
              full_screen = TRUE,
              # height = "100px",
              # width = .2,
              # max_height = "100px",
              theme_color = "success"
    ) %>%
      return()
  })
  
}

options(shiny.host = '0.0.0.0')
options(shiny.port = 8080)

shinyApp(ui, server)

I would not say {bslib} was meant to work with {bs4Dash}.

While {bs4Dash} uses bootstrap 4, {bslib} is more flexible on the version.

That said, I'd advice you choose to use either of them, but not both.

In this example, I use {bs4Dash} and bootstrap 4 classes to show how you can create and customize your own cards (and value boxes).

Note that I did not change the way you created the sparklines.

global.R

library(shiny)
library(bs4Dash)
library(plotly)
library(dplyr)

ui.R

ui <- bs4DashPage(
  dashboardHeader(title = "Test Dash"),
  bs4DashSidebar(
    sidebarMenu(
      id = "tab",
      menuItem("Test 1", tabName = "t1", icon = icon("dashboard")),
      menuItem("Test 2", tabName = "t2", icon = icon("triangle-exclamation"))
    )
  ),
  bs4DashBody(
    shinyjs::useShinyjs(),
    tabItems(
      tabItem(
        tabName = "t1",
        fluidRow(
          bs4Card(
            width = 8,
            create_card()
          )
        )               
      ),
      tabItem(
        tabName = "t2"
      )
    )
  )
)

create_card

create_card <- function(
    card_class = "bg-success text-white rounded py-2",
    plot_size = 4,
    plot_ui = plotlyOutput(outputId = "theplot", height = "100px"),
    card_header = tags$p("Series Data"),
    show_expand_icon = TRUE,
    icon_id = "expand",
    card_value = tags$h3("50")
) {
  fluidRow(
    class = card_class,
    column(
      width = plot_size,
      plot_ui
    ),
    column(
      width = 12 - plot_size,
      class = "pl-4",
      tags$div(
        class = "d-flex justify-content-between",
        tags$div(
          card_header,
        ),
        if (show_expand_icon) {
          tags$i(
            id = icon_id,
            style = "cursor: pointer;",
            class = "glyphicon glyphicon-resize-full"
          )
        }
      ),
      card_value
    )
  )
}

server.R

server <- function(input, output, session) {
  dat <- tibble(
    Date = seq(Sys.Date() - 59, Sys.Date(), by = 1),
    measure = rnorm(length(Date), 20 + (Date - min(Date)), 5)
  )
  
  sparkline <- plot_ly(dat) %>%
    add_lines(
      x = ~Date, y = ~measure, color = I("white"), span = I(1),
      fill = 'tozeroy', alpha = 0.2
    ) %>%
    layout(
      xaxis = list(visible = F, showgrid = F, title = ""),
      yaxis = list(visible = F, showgrid = F, title = ""),
      hovermode = "x",
      margin = list(t = 0, r = 0, l = 0, b = 0),
      font = list(color = "white"),
      paper_bgcolor = "transparent",
      plot_bgcolor = "transparent"
    ) %>%
    config(displayModeBar = F) %>%
    htmlwidgets::onRender(
      "function(el) {
          var ro = new ResizeObserver(function() {
            var visible = el.offsetHeight > 200;
            Plotly.relayout(el, {'xaxis.visible': visible});
          });
          ro.observe(el);
        }"
    )
  
  output$theplot <- renderPlotly(sparkline)
  
  plot_modal_tag_q <- modalDialog(
    title = fluidRow(
      column(
        width = 12,
        class = "d-flex justify-content-between",
        tags$div("Sparkline"),
        tags$div(
          tags$i(
            id = "close_modal",
            style = "cursor: pointer;",
            class = "glyphicon glyphicon-resize-small"
          )
        )
      )
    ),
    size = "xl",
    easyClose = TRUE,
    footer = NULL,
    create_card(
      plot_ui = plotlyOutput("card_ui_expanded"),
      plot_size = 10,
      show_expand_icon = FALSE
    )
  ) |> 
    htmltools::tagQuery()
  
  # change bg of modal:
  plot_modal_tag_q$find(".modal-content")$addClass("bg-success")
  # center modal:
  plot_modal_tag_q$find(".modal-dialog")$addClass("modal-dialog-centered")
  # full width title:
  plot_modal_tag_q$find(".modal-title")$addClass("w-100")
  plot_modal <- plot_modal_tag_q$allTags()
  
  output$card_ui_expanded <- renderPlotly(sparkline)
  
  shinyjs::onclick("expand", showModal(plot_modal))
  shinyjs::onclick("close_modal", removeModal())
}