R Shiny: Right Align and Left Align in the Same Dropdown Menu

Question

I am making an R Shiny app and would like to left align and right align in the same dropdown menu.

So in the example app:

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)

In the dropdown menu I would like the letters to be left aligned within the dropdown and the numbers and brackets to be right aligned.

I can separate them by a tab but the numbers won't be in line with each other unfortunately.

Thanks in advance for your help.

Answer 1

I've created a new column that combines column 1 and 2, then a little bit of Javascript is used to create HTML for each option.

It left aligns the value from column 1 and right aligns the value from column 2.

It can probably be done without creating the new column by passing the 2 columns to the Javascript function.

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)