Shiny 标题中的粒子动画

我想在仪表板的标题中添加粒子JS动画。我正在使用来自github的package particlejs-

它在仪表板主体下工作，但不在表头。我尝试在dashboardHeader（）中使用标记$li（class='dropdown'），但它没有显示动画

library(shiny)
library(particlesjs)


ui <- dashboardPage(
  
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    
    tags$li(class = "dropdown",
            tags$div(
              id="particles-target", 
              style = "position: absolute; height: 600px; width: 100%;"
            ),
            particles(target_id = "particles-target")
    ),
    
    # Boxes need to be put in a row (or column)
    fluidRow(
      box(plotOutput("plot1", height = 250)),
      
      box(
        title = "Controls",
        sliderInput("slider", "Number of observations:", 1, 100, 50)
      )
    )
  )
)

server <- function(input, output) {
  set.seed(122)
  histdata <- rnorm(500)
  
  output$plot1 <- renderPlot({
    data <- histdata[seq_len(input$slider)]
    hist(data)
  })
}

shinyApp(ui, server)

库（闪亮）
图书馆（particlesjs）
ui
库（闪亮）
图书馆（shinydashboard）
图书馆（particlesjs）
js
library(shiny)
library(shinydashboard)
library(particlesjs)

js <- "
$(document).ready(function(){
  var $navbar = $('.main-header .navbar');
  var height = $navbar.height() + 'px';
  var leftMargin = $navbar.find('a.sidebar-toggle').css('width');
  var rightMargin = $navbar.find('.navbar-custom-menu').css('width');
  var width = `calc(100% - ${rightMargin} - ${leftMargin})`;
  $('#particles-container').css({
    position: 'relative',
    width: width,
    height: height,
    'margin-left': leftMargin
  });
  $navbar.append($('#particles-container'));
});
"

ui <- dashboardPage(
  
  dashboardHeader(
    title = "Dashboard Demo",
    
    # Dropdown menu for messages
    dropdownMenu(type = "messages", badgeStatus = "success",
                 messageItem("Support Team",
                             "This is the content of a message.",
                             time = "5 mins"
                 ),
                 messageItem("Support Team",
                             "This is the content of another message.",
                             time = "2 hours"
                 ),
                 messageItem("New User",
                             "Can I get some help?",
                             time = "Today"
                 )
    )
  ),  
  
  dashboardSidebar(),
  
  dashboardBody(
    
    tags$head(tags$script(HTML(js))),
    tags$div(
      id = "particles-container",
      tags$div(
        id = "particles-target",
        style = "position: absolute; top: 0; bottom: 0; right: 0; left: 0;"
      )
    ),
    particles(target_id = "particles-target", element_id = "particles", 
              config = particles_config(
                particles.number.density.value_area = 100L,
                particles.color.value = "#ff0000",
                particles.line_linked.color = "#ffffff",
                particles.line_linked.width = 2L,
                particles.size.value = 6L
              )
    ),
    
    # Boxes need to be put in a row (or column)
    fluidRow(
      box(plotOutput("plot1", height = 250)),
      
      box(
        title = "Controls",
        sliderInput("slider", "Number of observations:", 1, 100, 50)
      )
    )
  )
)

server <- function(input, output) {
  set.seed(122)
  histdata <- rnorm(500)
  
  output$plot1 <- renderPlot({
    data <- histdata[seq_len(input$slider)]
    hist(data)
  })
}

shinyApp(ui, server)