RShiny 水平滚动导航面板

Question

我正在构建一个 ShinyApp，每页有几个 nav_panel。 shiny/bslib 的默认行为是将面板分成多行：

查看代码和图片：

library(shiny)
library(bslib)

# UI
ui <- page_fixed(
  theme = bs_theme(),
  
  # Basic use of navset_underline to showcase tabs with long names
  navset_underline(
    nav_panel("Very Long Name 1", "Content Tab 1"),
    nav_panel("Very Long Name 2", "Content Tab 2"),
    nav_panel("Very Long Name 3", "Content Tab 3"),
    nav_panel("Very Long Name 4", "Content Tab 4"),
    nav_panel("Very Long Name 5", "Content Tab 5"),
    nav_panel("Very Long Name 6", "Content Tab 6"),
    nav_panel("Very Long Name 7", "Content Tab 7"),
    nav_panel("Very Long Name 8", "Content Tab 8"),
    nav_panel("Very Long Name 9", "Content Tab 9"),
  )
)

# Server
server <- function(input, output, session) {}

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

相反，我希望将面板放在单行中，并用箭头滚动不可见的面板。 ChatGPT 给了我这个可行的解决方案，但是有没有更好、更简单的方法来实现这个目标呢？也许有些东西也适用于 page_fluid。我不喜欢在代码中插入 HTML：

library(shiny)
library(bslib)

ui <- page_fixed(
  theme = bs_theme(),
  tags$head(
    tags$style(HTML("
      /* Wrapper for arrows */
      .navset-scroll-wrapper {
        position: relative;
        display: flex;
        align-items: center;
      }

      /* Navigatin bar style */
      .nav.nav-underline {
        display: flex;
        flex-wrap: nowrap;
        overflow-x: auto;
        overflow-y: hidden;
        -webkit-overflow-scrolling: touch; /* scrolling fluido su mobile */
        scroll-behavior: smooth; /* scrolling fluido */
        margin-bottom: 0; /* Evita spazi sotto la barra */
      }

      /* Tab*/
      .nav.nav-underline .nav-item {
        flex-shrink: 0;
      }

      /* Remove visible scrollbar  */
      .nav.nav-underline::-webkit-scrollbar {
        display: none;
      }

      /* Arrow Style */
      .scroll-arrow {
        position: absolute;
        top: 50%;
        transform: translateY(-50%);
        z-index: 10;
        cursor: pointer;
        font-size: 20px;
        color: #333;
        background-color: #fff;
        border: 1px solid #ddd;
        border-radius: 50%;
        padding: 5px;
        display: flex;
        align-items: center;
        justify-content: center;
      }

      .scroll-arrow.left {
        left: -30px; /* Posiziona la freccia a sinistra */
      }

      .scroll-arrow.right {
        right: -30px; /* Posiziona la freccia a destra */
      }
    ")),
    tags$script(HTML("
      // Add horizontal scrolling
      document.addEventListener('DOMContentLoaded', function() {
        const leftArrow = document.querySelector('.scroll-arrow.left');
        const rightArrow = document.querySelector('.scroll-arrow.right');
        const navTabs = document.querySelector('.nav.nav-underline');

        leftArrow.addEventListener('click', () => {
          navTabs.scrollBy({ left: -100, behavior: 'smooth' });
        });

        rightArrow.addEventListener('click', () => {
          navTabs.scrollBy({ left: 100, behavior: 'smooth' });
        });
      });
    "))
  ),
  tags$div(
    class = "navset-scroll-wrapper",
    tags$div(class = "scroll-arrow left", "❮"), # Left Arrow
    navset_underline(
      nav_panel("Very Long Name 1", "Content Tab 1"),
      nav_panel("Very Long Name 2", "Content Tab 2"),
      nav_panel("Very Long Name 3", "Content Tab 3"),
      nav_panel("Very Long Name 4", "Content Tab 4"),
      nav_panel("Very Long Name 5", "Content Tab 5"),
      nav_panel("Very Long Name 6", "Content Tab 6"),
      nav_panel("Very Long Name 7", "Content Tab 7"),
      nav_panel("Very Long Name 8", "Content Tab 8"),
      nav_panel("Very Long Name 9", "Content Tab 9"),
    ),
    tags$div(class = "scroll-arrow right", "❯") # Right Arrow
  )
)

server <- function(input, output, session) {}

shinyApp(ui = ui, server = server)

谢谢！

Answer 1

编辑：经过一些尝试和错误，我解决了问题。我在这里写下其他用户的解决方案：

script.js

$(document).ready(function() {
  $('.scroll-left').click(function() {
    $('.nav-underline').animate({ scrollLeft: '-=200' }, 300);
  });
  
  $('.scroll-right').click(function() {
    $('.nav-underline').animate({ scrollLeft: '+=200' }, 300);
  });
});

样式.css

.nav-container {
  position: relative;
  padding: 0 40px;  /* Space for buttons */
}

.nav-underline {
  flex-wrap: nowrap !important;
  overflow-x: scroll;
  scrollbar-width: none;  /* Firefox */
  -ms-overflow-style: none;  /* IE and Edge */
  white-space: nowrap;
}

.nav-underline::-webkit-scrollbar {
  display: none;  /* Chrome, Safari, Opera */
}

.nav-item {
  white-space: nowrap;
}

.scroll-button {
  position: absolute;
  top: 50%;
  transform: translateY(-50%);
  z-index: 1000;
  background: #ffffff;
  border: 1px solid #dee2e6;
  border-radius: 4px;
  padding: 8px;
  cursor: pointer;
}

.scroll-left { left: 0; }
.scroll-right { right: 0; }

应用程序.R

library(shiny)
library(bslib)

# UI
ui <- page_fluid(
  theme = bs_theme(),
  
  tags$head(
    tags$link(rel = "stylesheet", type = "text/css", href = "styles.css"),
    tags$script(src = "script.js")
  ),
  
  div(class = "nav-container",
      tags$button(icon("chevron-left"), class = "scroll-button scroll-left"),
      
      navset_underline(
        nav_panel("Very Long Name 1", "Content Tab 1"),
        nav_panel("Very Long Name 2", "Content Tab 2"),
        nav_panel("Very Long Name 3", "Content Tab 3"),
        nav_panel("Very Long Name 4", "Content Tab 4"),
        nav_panel("Very Long Name 5", "Content Tab 5"),
        nav_panel("Very Long Name 6", "Content Tab 6"),
        nav_panel("Very Long Name 7", "Content Tab 7"),
        nav_panel("Very Long Name 8", "Content Tab 8"),
        nav_panel("Very Long Name 9", "Content Tab 9")
      ),
      
      tags$button(icon("chevron-right"), class = "scroll-button scroll-right")
  )
)

# Server
server <- function(input, output, session) {
}

shinyApp(ui = ui, server = server)