闪亮的标签滚动条

Question

如何添加一个箭头，让我可以单击并浏览我的所有标签。

我知道我可以在一个选项卡框中添加多个选项卡，然后单击每个选项卡以查看每个表。

但是有没有办法设计 UI，以便我可以使用箭头滚动整个页面并查看下一个选项卡

想把上面改成这个

编辑 添加了使用模块并允许用户根据滑块创建尽可能多的表的可重现代码

chartTableBoxUI <- function(id) {

  ns <- NS(id)


  div(
    tags$div(DTOutput(ns("chart"))),
    tags$div(DTOutput(ns("table")))

  )



}

chartTableBox <- function(input, output, session) {

  ns <- session$ns

  vals <- reactiveValues()

  observeEvent(input$chart_rows_selected,{

    vals$sel<- (input$chart_rows_selected)


  })

  output$chart <- renderDT({
    DT::datatable(
      mtcars,options = list(
        dom='t', pageLength = 5)

    )
  })

  output$table <- renderDT({


    DT::datatable(
      mtcars[vals$sel, 1:3],options = list(dom='t')
    )




  })

}

library(shiny)
library(shinydashboard)
library(tidyverse)
library(highcharter)
library(DT)
library(shinyjs)

ui <- fluidPage(

  fluidRow(
    tags$head(
      tags$link(rel="stylesheet", type="text/css",
                href="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick-theme.css"),
      tags$link(rel="stylesheet", type="text/css",
                href="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick.css"),
      tags$script(type="text/javascript", 
                  src="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick.js"),
      tags$script(HTML(
        "$(document).ready(function(){
        $('#tables').slick({
        arrows: true,
        dots:true
        });
        });")),
    tags$style(HTML(
      "#tables .slick-prev {
      position:absolute;
      top:65px; 
      left:-100px;
      }
      #tables .slick-next {
      position:absolute;
      top:95px; 
      left:-100px;
      }
      .slick-prev:before, .slick-next:before { 
      color:red !important;
      }
      .content {
      margin: auto;
      padding: 20px;
      width: 80%;
      }"))
  ),



  sliderInput("dr", "Num of tables:",
              min = 0, max = 12,
              value = 2),
  uiOutput("tabs")
  #verbatimTextOutput("dr2")





    )

    )





server <- function(input, output, session) {
  for(i in 1:5)
    callModule(chartTableBox,i)

  output$tabs <- renderUI({
     num_tables<- input$dr


    tags$div(class="content",
             tags$div(id="tables",
                      lapply(1:num_tables,chartTableBoxUI)



             ))


  })





}

shinyApp(ui, server)

Answer 1

使用slick.js 库的无标签解决方案。我不知道如何将按钮并排放置。

library(shiny)
library(DT)

ui <- fluidPage(
  tags$head(
    tags$link(rel="stylesheet", type="text/css",
              href="//cdn.jsdelivr.net/gh/kenwheeler/slick@1.8.1/slick/slick.css"),
    tags$script(type="text/javascript", 
                src="//cdn.jsdelivr.net/gh/kenwheeler/slick@1.8.1/slick/slick.min.js"),
    tags$script(HTML(
"$(document).ready(function(){
  $('#tables').slick({
    // put options here
  });
});"))
  ),
  sidebarLayout(
    sidebarPanel(
      ####
    ),

    mainPanel(
      tags$div(id="tables", 
               tags$div(DTOutput("table1")),
               tags$div(DTOutput("table2"))
      )
    )
  )
)

server <- function(input, output) {

  output$table1 <- renderDT({
    datatable(iris)
  })
  output$table2 <- renderDT({
    datatable(mtcars)
  })

}

shinyApp(ui = ui, server = server)

编辑

我终于设法将上一个/下一个按钮分组：

library(shiny)
library(DT)

ui <- fluidPage(
  tags$head(
    tags$link(rel="stylesheet", type="text/css",
              href="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick-theme.css"),
    tags$link(rel="stylesheet", type="text/css",
              href="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick.css"),
    tags$script(type="text/javascript", 
                src="https://cdnjs.cloudflare.com/ajax/libs/slick-carousel/1.9.0/slick.js"),
    tags$script(HTML(
"$(document).ready(function(){
  $('#tables').slick({
    arrows: true,
    dots:true
  });
});")),
    tags$style(HTML(
"#tables .slick-prev {
    position:absolute;
  top:65px; 
  left:-100px;
}
#tables .slick-next {
  position:absolute;
  top:95px; 
  left:-100px;
}
.slick-prev:before, .slick-next:before { 
    color:red !important;
}
.content {
    margin: auto;
    padding: 20px;
    width: 80%;
}"))
  ),
  sidebarLayout(
    sidebarPanel(
      ####
    ),

    mainPanel(
      tags$div(class="content",
        tags$div(id="tables", 
                 tags$div(DTOutput("table1")),
                 tags$div(DTOutput("table2"))
        )
      )
    )
  )
)

server <- function(input, output) {

  output$table1 <- renderDT({
    datatable(iris)
  })
  output$table2 <- renderDT({
    datatable(mtcars)
  })

}

shinyApp(ui = ui, server = server)

编辑 2

关于您的编辑，您可以从 tags$head 中删除 tags$script(HTML(.... 并执行以下操作：

  output$tabs <- renderUI({
    num_tables<- input$dr
    tagList(
      tags$div(class="content",
               tags$div(id="tables",
                        lapply(1:num_tables,chartTableBoxUI)
               )),
      singleton(tags$script(HTML(
        "$(document).ready(function(){
        $('#tables').slick({
        arrows: true,
        dots:true
        });
        });")))
    )
  })