闪亮光滑的R旋转木马与标签板的内部链接

Question

我想要创建一个闪亮的navbarPage仪表板，其中有一个slickR旋转图像降落页面。每个图像应该有一个动作按钮重叠，链接到不同的tabPanel。基本上应该是这样的：玩具应用程序截图这里是一个可复制的玩具示例，它不能完成任务：

library(shiny)
library(slickR)
# ui
ui <- navbarPage(title = "", id = "pageid",
                 tabsetPanel(id="tabs",
                             tab1 <- tabPanel(title="Tab 1", value="tab1",
                                              fluidRow(
                                                slickROutput("slickr1"),
                                                h1("Title", style =
                                                     "position: relative;
                                                      margin-top:-43%;
                                                      color:#4BACC6;
                                                      font-size:30px;
                                                      text-align: center"),
                                                div(actionButton("action1", "Action",
                                                                 style="position: relative;
                                                                  margin-top: 15%;
                                                                  color:#FFFEFB;
                                                                  background-color:#4BACC6;
                                                                  border-color:#4BACC6;"), 
                                                    align="center"),
                                                                            )),
                             tab2 <- tabPanel(title="Tab 2", value="tab2"),
                             tab3 <- tabPanel(title="Tab 3", value="tab3")
                 )
)

# server
server <- function(input, output, session) {
  output$slickr1 <- renderSlickR({
    slick1 <- slick_list(slick_div(
      nba_player_logo$uri[1:3],
      type = "img", links = NULL)
    )
    slickR(slick1) +
      settings(dots = TRUE,
               autoplay = TRUE)
  })
  observeEvent(input$action1, {
    updateTabsetPanel(session, "tabs",
                      selected = "tab2")
  })
}

‘这段代码在旋转木马上的所有三个图像上都叠加了相同的操作按钮和标题，我无法让slickR同时运行图像和操作按钮。

我尝试在slick_div中创建第二个slick_list，它通过三个不同的操作按钮运行，如下所示：

# server
server <- function(input, output, session) {
  buttons <- list(actionButton("action1", "Action1"),
                 actionButton("action2", "Action2"),
                 actionButton("action3", "Action3"))                         
  output$slickr1 <- renderSlickR({
    slick1 <- slick_list(slick_div(
      nba_player_logo$uri[1:3],
      type = "img", links = NULL),
    slick_div(
      buttons,
      css = htmltools::css(display = "inline"),
      links = NULL)
  )
    slickR(slick1) +
      settings(dots = TRUE,
               autoplay = TRUE)
  })
  observeEvent(input$action1, {
    updateTabsetPanel(session, "tabs",
                      selected = "tab2")
  })
}

但最终，幻灯片1和幻灯片2上的所有动作按钮相互堆叠在一起，而不是一张接一张地浏览，每张幻灯片上都有一个动作按钮。

或者，我也可以打开整个图像链接到一个不同的选项卡，并考虑在slick_div中使用"links“选项(在上面的玩具示例中设置为NULL )，但是我很难为每个可以分配给"links”的选项卡确定一个url。

我是新来的闪亮的，并将非常感谢您的帮助！

Answer 1

我不确定能理解。是你想要的吗？

library(shiny)
library(slickR)

css <- "
.slidetitle {
  position: relative;
  color: #4BACC6;
  font-size: 30px;
  text-align: center;
}
.slidebutton {
  position: relative;
  margin-top: -15%;
  color: #FFFEFB;
  background-color: #4BACC6;
  border-color: #4BACC6;
}
"


# ui
ui <- navbarPage(
  title = "SlickR with buttons", 
  id = "tabs",
  header = tags$head(tags$style(HTML(css))),
  tabPanel(
    title= "Tab 1", value = "tab1",
    fluidRow(
      slickR(slick_list(
        tags$div(
          tags$h1("Title 1", class = "slidetitle"),
          tags$img(
            src = "https://cdn.pixabay.com/photo/2018/07/31/22/08/lion-3576045__340.jpg",
            height = 500
          ),
          actionButton(
            "action1", "Action 1", class = "slidebutton"
          ),
          align = "center"
        ),
        tags$div(
          tags$h1("Title 2", class = "slidetitle"),
          tags$img(
            src = "https://cdn.pixabay.com/photo/2012/02/27/15/35/lion-17335__340.jpg",
            height = 500
          ),
          actionButton(
            "action2", "Action 2", class = "slidebutton"
          ),
          align = "center"
        ),
        tags$div(
          tags$h1("Title 3", class = "slidetitle"),
          tags$img(
            src = "https://www.aprenderjuntos.cl/wp-content/uploads/2020/08/LEON-SERIO-.jpg",
            height = 500
          ),
          actionButton(
            "action3", "Action 3", class = "slidebutton"
          ),
          align = "center"
        )
      )) + settings(autoplay = TRUE, dots = TRUE)
    )
  ),
  tabPanel(
    title = "Tab 2", value = "tab2",
    tags$h1("TAB 2")
  ),
  tabPanel(
    title = "Tab 3", value = "tab3",
    tags$h1("TAB3")
  )
)

# server
server <- function(input, output, session) {
  observeEvent(input$action1, {
    updateNavbarPage(session, "tabs", selected = "tab2")
  })
}

shinyApp(ui, server)