R Shiny：在同一个下拉菜单中右对齐和左对齐

Question

我正在制作一个 R Shiny 应用程序，并希望在同一个下拉菜单中左对齐和右对齐。

所以在示例应用中：

library(shiny)


# Define UI 
ui <- fluidPage(

  # App title ----
  titlePanel("Dropdown Problems"),

  # Sidebar layout with input and output definitions 
  sidebarLayout(

    # Sidebar panel for inputs 
    sidebarPanel(

    # Define Dropdown Menu
    selectizeInput("selection_dropdown", "Select Selection of Interest:",
        choices=NULL,
        options=list(
          maxItems=1,
          placeholder='Select Selection',
          create=TRUE)
        )
    ),
    # Main panel for displaying outputs ----
    mainPanel(

    # Output: 
    plotOutput(outputId = "sample_plot")
    )
  )
)

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

# Define New Data Frame 
new_data_frame <- data.frame(column1=c("aaaaaaaa","bb","cccc"),column2=c(1,2,3),column3=c("plot_a","plot_b","plot_c"))

# Create Dropdown Menu 
observe({
dropdown_choices <- paste(new_data_frame$column1," (",new_data_frame$column2,")",sep="")
updateSelectizeInput(
            session,
            "selection_dropdown",
            choices=dropdown_choices,
            server=TRUE,
            )
            })
# Create Output Plot (This doesn't really matter)
output$sample_plot <- renderPlot({
    plot_selection <- gsub(" .*","",input$selection_dropdown)
    plot_selection <- new_data_frame$column3[new_data_frame$column1==plot_selection]
    plot(
    x=NA,
    y=NA,
    xlim=c(0,100),
    ylim=c(0,100)
    )
    text(x=50,y=50,plot_selection)
    })

}

shinyApp(ui = ui, server = server)

在下拉菜单中，我希望字母在下拉菜单中左对齐，数字和括号右对齐。

我可以用制表符将它们分开，但不幸的是这些数字彼此不一致。

提前感谢您的帮助。

Answer 1

这个怎么样

我们可以使用 CSS 中的 counter 技巧，以便这些数字根据它们在下拉列表中的显示顺序自动分配。这意味着您不需要手动添加索引。当它被选中时，在服务器上，它返回没有索引的值。

library(shiny)


# Define UI 
ui <- fluidPage(
    tags$style(
        '
        :root {counter-reset: mycounter;}
        .selectize-dropdown-content .option::after {
            counter-increment: mycounter;
            content: "(" counter(mycounter) ")";
            float: right;
        }
        '
    ),
    # App title ----
    titlePanel("Dropdown Problems"),
    # Sidebar layout with input and output definitions 
    sidebarLayout(
        
        # Sidebar panel for inputs 
        sidebarPanel(
            
            # Define Dropdown Menu
            selectizeInput("selection_dropdown", "Select Selection of Interest:",
                           choices=NULL,
                           options=list(
                               maxItems=1,
                               placeholder='Select Selection',
                               create=TRUE)
            )
        ),
        # Main panel for displaying outputs ----
        mainPanel(
            
            # Output: 
            plotOutput(outputId = "sample_plot")
        )
    )
)

server <- function(session,input, output) {
    
    # Define New Data Frame 
    new_data_frame <- c("aaaaaaaa","bb","cccc")
    
    # Create Dropdown Menu 
    observe({
        updateSelectizeInput(
            session,
            "selection_dropdown",
            choices=new_data_frame,
            server=TRUE,
        )
    })
    # Create Output Plot (This doesn't really matter)
    output$sample_plot <- renderPlot({
        plot_selection <- gsub(" .*","",input$selection_dropdown)
        plot(
            x=NA,
            y=NA,
            xlim=c(0,100),
            ylim=c(0,100)
        )
        text(x=50,y=50,plot_selection)
    })
    
}

shinyApp(ui = ui, server = server)

更新：

如果您的索引不是有序数字，我们仍然可以这样做。 我只是假设您的数据仍在从服务器发送选项，即使您的演示数据似乎可以纯粹从 UI 完成。想象一下你的索引是一些随机数。我们可以将这些数字作为 CSS 样式发送到 UI 并格式化下拉菜单。

library(shiny)
library(glue)
library(magrittr)
# Define UI 
ui <- fluidPage(
    # App title ----
    titlePanel("Dropdown Problems"),
    # Sidebar layout with input and output definitions 
    sidebarLayout(
        
        # Sidebar panel for inputs 
        sidebarPanel(
            
            # Define Dropdown Menu
            uiOutput("style"),
            selectizeInput("selection_dropdown", "Select Selection of Interest:",
                           choices=NULL,
                           options=list(
                               maxItems=1,
                               placeholder='Select Selection',
                               create=TRUE)
            )
        ),
        # Main panel for displaying outputs ----
        mainPanel(
            
            # Output: 
            plotOutput(outputId = "sample_plot")
        )
    )
)

server <- function(session,input, output) {
    
    # Define New Data Frame 
    new_data_frame <- c("aaaaaaaa","bb","cccc")
    indices <- sample(999, 3)
    output$style <- renderUI(
        tags$style(glue(.open = '@{', .close = "}@",
            '
            .selectize-dropdown-content .option:nth-child(@{seq_along(indices)}@)::after {
                content: "(@{indices}@)";
                float: right;
            }
            '
        ) %>% glue_collapse("\n"))
    )
    # Create Dropdown Menu 
    observe({
        updateSelectizeInput(
            session,
            "selection_dropdown",
            choices=new_data_frame,
            server=TRUE,
        )
    })
    # Create Output Plot (This doesn't really matter)
    output$sample_plot <- renderPlot({
        plot_selection <- gsub(" .*","",input$selection_dropdown)
        plot(
            x=NA,
            y=NA,
            xlim=c(0,100),
            ylim=c(0,100)
        )
        text(x=50,y=50,plot_selection)
    })
    
}

shinyApp(ui = ui, server = server)

Answer 2

我创建了一个新列，它结合了第 1 列和第 2 列，然后使用一点 Javascript 为每个选项创建 HTML。

它左对齐第 1 列的值，右对齐第 2 列的值。

通过将 2 列传递给 Javascript 函数，可能无需创建新列即可完成。

library(shiny)


# Define UI 
ui <- fluidPage(
  
  # App title ----
  titlePanel("Dropdown Problems"),
  
  # Sidebar layout with input and output definitions 
  sidebarLayout(
    
    # Sidebar panel for inputs 
    sidebarPanel(
      
      # Define Dropdown Menu
      selectizeInput("selection_dropdown", "Select Selection of Interest:",
                     choices=NULL,
                     options=list(
                       maxItems=1,
                       placeholder='Select Selection',
                       create=TRUE)
      )
    ),
    # Main panel for displaying outputs ----
    mainPanel(
      
      # Output: 
      plotOutput(outputId = "sample_plot")
    )
  )
)

server <- function(session,input, output) {
  
  # Define New Data Frame 
  new_data_frame <- data.frame(column1=c("aaaaaaaa","bb","cccc"),column2=c(1,2,3),column3=c("plot_a","plot_b","plot_c"))
  new_data_frame$column4 <-paste0(new_data_frame$column1, " (", new_data_frame$column2, ")")
  # Create Dropdown Menu 
  observe({
    dropdown_choices <- new_data_frame$column4
    updateSelectizeInput(
      session,
      "selection_dropdown",
      choices=dropdown_choices,
      options = list(render = I(
        '{
    option: function(item, escape) {
      const x = item.value.split(" ");
      return `<p style=\"text-align:left;\">
    ${x[0]}
    <span style=\"float:right;\">
        ${x[1]}
    </span>
</p>`
    }
  }')),
      server=TRUE,
    )
  })
  
  # Create Output Plot (This doesn't really matter)
  output$sample_plot <- renderPlot({
    plot_selection <- gsub(" .*","",input$selection_dropdown)
    plot_selection <- new_data_frame$column3[new_data_frame$column1==plot_selection]
    plot(
      x=NA,
      y=NA,
      xlim=c(0,100),
      ylim=c(0,100)
    )
    text(x=50,y=50,plot_selection)
  })
  
}

shinyApp(ui = ui, server = server)