R语言 bs4Dash中的bslib：：value_box未按预期显示

7kqas0il 于 2023-06-19 发布在其他

关注(0)|答案(2)|浏览(133)

我正试图适应我自己的应用程序the last example in this documentation的创建valueBoxes与“展示”dSpark线作出互动通过plotly。这个例子并没有在一个shiny应用程序中进行渲染，bslib包也不包括渲染/输出函数。
我已经通过renderUI/uiOutput函数得到了一些 * 排序 * 的工作，但结果不尊重bs4Dash（或任何其他框架）中的值和所展示的sparkline之间的比例和定位。在RStudio中以交互方式运行代码会在Viewer窗格中显示所需的结果。我正在寻找帮助，以配合在我的闪亮的应用程序的文章上面链接的渲染输出
MRE下方

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

来源：https://stackoverflow.com/questions/76393250/bslibvalue-box-within-bs4dash-displays-not-as-intended

2条答案

按热度按时间

kwvwclae1#

我不会说{bslib}是为了与{bs4Dash}一起工作。
{bs4Dash}使用bootstrap 4，{bslib}在版本上更灵活。
也就是说，我建议你选择使用其中的一个，但不是两者都使用。
在这个例子中，我使用{bs4Dash}和bootstrap 4类来展示如何创建和定制自己的卡片（和值盒）。
请注意，我没有更改创建迷你图的方式。
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())
}

赞(0）回复(0）举报 2023-06-19

fhity93d2#

当您在Shiny之外创建卡时，很多stying来自Bootstrap 5，这与bs4Dash（Bootstrap 4 Dash）相矛盾。所以样式被删除了，一些样式导致了你这里的问题。我确实找到了一个变通方法，可以让你继续你当前的应用程序样式，同时解决卡的问题。
我想指出的是，卡显然是设计的30% -70%。所以左边的得到30%的可用空间，右边的得到70%的可用空间。在ui中将宽度设置为3，即使在大屏幕上，也会使图形几乎不存在（特别是由于填充）。我在下面的代码中将其更改为8。
唯一的变化是在 body 中添加了CSS。我没有把这个CSS放在你的应用程序的头部，因为它会成为侧边栏中一些当前设置的问题。
这是我通过比较孤立值框背后的CSS和CSS中的CSS来捕获的CSS。（所以我这边没什么特别聪明的。
未对server进行任何变更。

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(
    tags$style(HTML(
    ".bslib-value-box .value-box-grid {
      grid-template-columns: var(--bslib-value-box-widths);
    }
    .bslib-column-wrap {
        display: grid !important;
        gap: 1rem;
        height: var(--bslib-column-wrap-height);
    }
    .bslib-value-box .value-box-showcase {
      align-items: center;
      justify-content: center;
      margin-top: auto;
      margin-bottom: auto;
      padding: 1rem;
      max-height: var(--bslib-value-box-max-height);
    }"
    )),
    tabItems(tabItem(
      tabName = "t1",
      fluidRow(box(width = 8,           # <--- changed from 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,
              theme_color = "success") %>%
      return()
  })
}

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

shinyApp(ui, server)

赞(0）回复(0）举报 2023-06-19

我来回答

R语言 bs4Dash中的bslib：：value_box未按预期显示

2条答案

相关问题

热门标签

最新问答