将 Rintrojs 与闪亮仪表板相结合

Question

我刚刚开始使用rintrojs包，我想将它与该shinydashboard包混合起来。我特别想采取以下步骤：

• 侧边栏，
• 标题（图中为蓝色）
• 允许关闭和打开侧边栏的按钮（我在图像中用红色包围）

我尝试从他们的 github 页面上的示例开始，并在侧边栏上添加第六步，但它返回了一个错误

library(rintrojs)
library(shiny)
library(shinydashboard)

# Define UI for application that draws a histogram
ui <- shinyUI(
  dashboardPage(
    dashboardHeader(title = "Basic dashboard"),
    introBox(dashboardSidebar(

    ),data.step = 6,
    data.intro = 'This is the sidebar'),
    dashboardBody(
      fluidPage(
        introjsUI(),

        # Application title
        introBox(
          titlePanel("Old Faithful Geyser Data"),
          data.step = 1,
          data.intro = "This is the title panel"
        ),

        # Sidebar with a slider input for number of bins
        sidebarLayout(sidebarPanel(
          introBox(
            introBox(
              sliderInput(
                "bins",
                "Number of bins:",
                min = 1,
                max = 50,
                value = 30
              ),
              data.step = 3,
              data.intro = "This is a slider",
              data.hint = "You can slide me"
            ),
            introBox(
              actionButton("help", "Press for instructions"),
              data.step = 4,
              data.intro = "This is a button",
              data.hint = "You can press me"
            ),
            data.step = 2,
            data.intro = "This is the sidebar. Look how intro elements can nest"
          )
        ),

        # Show a plot of the generated distribution
        mainPanel(
          introBox(
            plotOutput("distPlot"),
            data.step = 5,
            data.intro = "This is the main plot"
          )
        ))
      )
    )
  )
)

# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
  # initiate hints on startup with custom button and event
  hintjs(session, options = list("hintButtonLabel"="Hope this hint was helpful"),
         events = list("onhintclose"=I('alert("Wasn\'t that hint helpful")')))

  output$distPlot <- renderPlot({
    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    # draw the histogram with the specified number of bins
    hist(x,
         breaks = bins,
         col = 'darkgray',
         border = 'white')
  })

  # start introjs when button is pressed with custom options and events
  observeEvent(input$help,
               introjs(session, options = list("nextLabel"="Onwards and Upwards",
                                               "prevLabel"="Did you forget something?",
                                               "skipLabel"="Don't be a quitter"),
                       events = list("oncomplete"=I('alert("Glad that is over")')))
  )
})

# Run the application
shinyApp(ui = ui, server = server)

tagAssert(sidebar, type = "aside", class = "main-sidebar") 中的错误：预期标签的类型为aside

第二个问题：是否可以在一个独特的 rintrojs 演示文稿中在侧边栏的不同菜单项之间导航？

Answer 1

这对你来说可能已经太晚了，但对于像我刚才那样绕过这个问题的其他人来说可能已经太晚了。

第一个技巧是在服务器端实现介绍逻辑。第二个技巧是用它们的class来指向元素，而不是它们的id。它可能有副作用，但在你的简单情况下，它就像一个魅力。

library(rintrojs)
library(shiny)
library(shinydashboard)

ui <- shinyUI(
    dashboardPage(
        dashboardHeader(title = "Basic dashboard"),
        dashboardSidebar(
            introjsUI(),
            sidebarMenu(
                menuItem("Item1", tabName="item1", icon=icon("dashboard")),
                menuItem("Item2", tabName="item2", icon=icon("thumbs-up"))
            )
        ),
        dashboardBody(
            fluidPage(
                titlePanel("Old Faithful Geyser Data"),
                sidebarLayout(
                    sidebarPanel(
                        sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
                        actionButton("help", "Press for instructions"),
                    ),
                    mainPanel(
                        plotOutput("distPlot"),
                    )
                )
            )
        )
    )
)

server <- shinyServer(function(input, output, session) {
    steps <- reactive(
        data.frame(
            element=c(".sidebar-menu", ".main-header", ".sidebar-toggle", ".active", "#help"),
            intro=c(
                "This is a sidebar. Note that we access it with '.' instead of '#', because we track its class and not its id.",
                "This is a header.",
                "This is a button that allows to close and open the sidebar.",
                "This is the active element of the sidebar.",
                "This is a button that I added just to show the normal way to point to elements: with their id."
            ),
            position=c("right", "bottom", "bottom", "right", "top")
        )
    )
    observeEvent(input$help,
        introjs(session,
            options = list(steps=steps(),
                "nextLabel"="Next",
                "prevLabel"="Previous",
                "skipLabel"="Skip"
            ),
            events = list("oncomplete"=I('alert("Done")'))
        )
    )

    output$distPlot <- renderPlot({
        x <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = input$bins + 1)
        hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })
})

shinyApp(ui = ui, server = server)

至于你的第二个问题，据我所知，你不能。