在 shinydashboardPlus() 中将动态图片 url link 传递给 UI 不起作用

Question

我正在使用 shinydashboardPlus() 中的 widgetUserBox()，我正在尝试有条件地将 url 字符串从服务器传递到 widgetUserBox() 的 backgroundUrl 选项在 UI 中显示图像作为用户框的背景。这不起作用，框只是默认为黑色背景，而不是跟随 url link 到图像。

我能够成功地将文本从服务器传递到 widgetUserBox 的其他元素，即。标题、副标题和页脚，但无法让 backgroundUrl 跟随 link。我曾尝试使用 renderText() 、 renderUI() 和 verbatimTextOutput() 将 url 字符串传递给 backgroundUrl，但都没有成功。是否有 solution/workaround 能够将 url 字符串从服务器发送到 backgroundUrl？

我有以下问题的示例：

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

ui = dashboardPagePlus(

  header = dashboardHeaderPlus(),
  
  sidebar = dashboardSidebar(
    sidebarMenu(
      menuItem("Tab 1", tabName = "Tab_1"))) , 
    
    body = dashboardBody(
      tabItems(
        tabItem(tabName = "Tab_1" ,
            fluidRow(
                 column(4,
                       textOutput("countText") , 
                         
                       br() , 
                       br() , 
                       
                       actionButton('push','Push Me'),
                       
                       br() , 
                       br() , 
                       
                       widgetUserBox( 
                           title =  textOutput("titleText") , 
                           subtitle = textOutput("subtitleText") ,
                           type = 2,
                           width = 12,
                           background = T,
                           backgroundUrl = textOutput("urlText") ,
                           closable = F,
                           collapsible = F , 
                           textOutput("footerText"))
                       ))
                       ))
                       ))
    

server = function(input, output,session) {
 
  counter <- reactiveValues(value = 1)
  
  output$titleText <- renderText({ "Can pass text to title" })
  output$subtitleText <- renderText({ "and to subtitle" })
  output$footerText <- renderText({ "and to footer" })
  output$countText <- renderText({ paste0(counter$value) })

  
  observeEvent(input$push, {
    
    # Add to count
    counter$value <- counter$value + 1
    
    # Arbitrary condition to evaluate which text to output (if counter value is odd, display 1st image, if even then the second)
    if ((counter$value %% 2) == 0) {
      
      output$urlText <- renderText({ paste0("https://i.ibb.co/7CVQ1Vk/Carlton-Blues-Banner4.png") })
      
    } else {
      
      output$urlText <- renderText({ paste0("https://i.ibb.co/3C8dc71/Brisbane-Lions-Banner.png") })
      
      
    }
  
  })

   
}
    
shinyApp(ui = ui, server = server)

Answer 1

这是在服务器端呈现 widgetUserBox 的解决方案。

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

ui = dashboardPagePlus(
  
  header = dashboardHeaderPlus(),
  
  sidebar = dashboardSidebar(
    sidebarMenu(
      menuItem("Tab 1", tabName = "Tab_1"))) , 
  
  body = dashboardBody(
    tabItems(
      tabItem(tabName = "Tab_1" ,
              fluidRow(
                column(4,
                       textOutput("countText") , 
                       
                       br() , 
                       br() , 
                       
                       actionButton('push','Push Me'),
                       
                       br() , 
                       br() , 
                       uiOutput("my_box")
                ))
      ))
  ))


server = function(input, output,session) {
  
  counter <- reactiveValues(value = 1)
  my_url <- reactiveVal()

  output$countText <- renderText({ paste0(counter$value) })
  
  output$my_box <- renderUI({
    widgetUserBox( 
      title =   "Can pass text to title" , 
      subtitle = "and to subtitle" ,
      type = 2,
      width = 12,
      background = T,
      backgroundUrl = my_url() ,
      closable = F,
      collapsible = F , 
      "and to footer")
  })
  
  
  observeEvent(input$push, {
    
    # Add to count
    counter$value <- counter$value + 1
    
    # Arbitrary condition to evaluate which text to output (if counter value is odd, display 1st image, if even then the second)
    if ((counter$value %% 2) == 0) {
      
      my_url("https://i.ibb.co/7CVQ1Vk/Carlton-Blues-Banner4.png")
      
    } else {
      
      my_url("https://i.ibb.co/3C8dc71/Brisbane-Lions-Banner.png")
      
      
    }
    
  })
  
  
}

shinyApp(ui = ui, server = server)

编辑

我实际上不确定您是否可以使用您使用的模式找到解决方案。如果您查看 widgetUserBox 的源代码，backgroundUrl 的使用方式如下：

backgroundStyle <- paste0("background: url('", 
                              backgroundUrl, "') center center;")

，稍后用于生成 div 标签。但是，textOutput 将文本包装在 span 或 div 标记中（参见 container 参数），因此它不再是纯文本。

在 shinydashboardPlus() 中将动态图片 url link 传递给 UI 不起作用

Passing dynamic picture url link to UI in shinydashboardPlus() not working

r

shiny

shiny-server

shinydashboard

shinyapps

编辑