编辑

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”）中的错误：预期的标记应放在一边

第二个问题：是否可以在一个唯一的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)

关于您的第二个问题，据我所知，您不能。

Answer 2

要回答第二个问题：

正如@Vongo（我认为是正确的）所指出的，这不可能直接实现。

话虽如此，我发现了一种骇人听闻的方式，可让您处理不同的部分。如前所述，诀窍是通过 class 而不是 id 来处理元素，查看menuItem()的输出，我们看到最高的元素（{{ 1}}）没有上课...

li

我们可以做的是重载shinydashboard::menuItem("Menu 1", tabName = "menu_1") #> <li> #> <a href="#shiny-tab-menu_1" data-toggle="tab" data-value="menu_1"> #> <span>Menu 1</span> #> </a> #> </li>函数来分配一个类。

警告，这只是经过轻微测试，可能会破坏应用程序的某些部分，尤其是如果您按位置而不是名称传递选项（即menuItem比menuItem("Menu 1", "menu_1")危险得多））。

menuItem(text = "Menu 1", tabName = "menu1")

使用此替代，我们可以将第一个菜单命名为menuItem <- function(text, tabName, ...) { r <- shinydashboard::menuItem(text, ...) r$attribs <- append(r$attribs, list(class = tabName)) r } menuItem("Menu 1", tabName = "menu_1") #> <li class="menu_1"> #> <a href="#"> #> <span>Menu 1</span> #> </a> #> </li>。

有关更详尽的示例，请参见以下示例：

.menu_1

编辑

一种不太麻烦但劳动密集型的解决方法是：

library(shinydashboard)
library(rintrojs)

menuItem <- function(text, tabName, ...) {
  r <- shinydashboard::menuItem(text, ...)
  r$attribs <- append(r$attribs, list(class = tabName))
  r
}

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Menu 1", tabName = "menu_1"),
      menuItem("Menu 2", tabName = "menu_2"),
      actionButton("btn_info", "Help")
    )
  ),
  dashboardBody(
    introjsUI()
  )
)

steps_general <- tibble::tribble(
  ~element, ~intro,
  NA, "First Empty State",
  ".menu_1", "First Item",
  ".menu_2", "Second Item"
)
server <- function(input, output, session) {
  observeEvent(input$btn_info, introjs(session, options = list(steps = steps_general)))
}
shinyApp(ui, server)

然后可以在用户界面代码中使用

# adds a class to a shiny element
add_class <- function(x, class) {
  x$attribs <- append(x$attribs, list(class = class))
  x
}

可以找到完整的示例in this gist。

结合使用Rintrojs和Shinydashboard

2 个答案:

编辑