Avoid overlapping text in sliderTextInput

Question

I am using sliderTextInput from the shinyWidgets package. I am having trouble making the labels readable.

To begin with, they are too small, which I have fixed using css. However, now the labels overlap so it is hard to read them.

I would like to be able to do one or both of the following:

Angle the text at 45 or 90 degrees so labels don't overlap.
Reduce the number of labels so there is more space between them. I tried doing this in the choices = argument but that then stops those options from being selected. I think this might be to do with this relating to text rather than numbers, so that might make this impossible.

I have tried using sliderInput instead, but that presents different issues. I almost got it working using this answer, but the additional problem is that I have the input server side, fed in as a uiOutput, which is something I can't change because it's important for a different element. This approach doesn't work with the linked solution - I end up with nice enough labels but the breaks are daily rather than monthly.

Here is a pared down example:

Using sliderTextInput (labels overlapping)

library(shinydashboard)
library(shinyWidgets)
library(shiny)


ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
   tags$head(tags$style(type = "text/css", ".irs-grid-text {font-size: 12pt !important;")),
    fluidRow(
      box(uiOutput("month_selection"))
      )
    )
  )

server <- function(input, output) {
  output$month_selection <- renderUI({
    sliderTextInput(
      inputId = "month_select",
      label = "",
      grid = TRUE, 
      force_edges = TRUE,
      choices = seq(from = as.Date("2017-01-01"), to = as.Date("2019-12-31"),by = 30)
    )
  })

}

shinyApp(ui, server)

Using sliderInput (doesn't run)


library(shinydashboard)
library(shinyWidgets)
library(shiny)

monthStart <- function(x) {
  x <- as.POSIXlt(x)
  x$mday <- 1
  as.Date(x)
}

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
   tags$head(tags$style(type = "text/css", ".irs-grid-text {font-size: 12pt !important;")),
    fluidRow(
      box(uiOutput("month_selection"))
      )
    )
  )

server <- function(input, output) {

  output$month_selection <- renderUI({
    sliderInput(
      inputId = "month_select",
      label = "",
      min = as.Date("2017-01-01"),
      max = as.Date("2019-12-31"),
      value = as.Date("2019-12-31"),
      timeFormat = "%b %Y",
      animate = TRUE
    )
  })

  sliderMonth <- reactiveValues()
  observe({
    sliderMonth$Month <- as.character(monthStart(input$month_select))
  })

}

shinyApp(ui, server)

> Warning: Error in as.POSIXlt.default: do not know how to convert 'x' to class “POSIXlt”

I've opened an issue on the package: https://github.com/dreamRs/shinyWidgets/issues/213 — Jaccar, Aug 16 '19 at 07:58

Jan · Answer 1 · 2021-01-14T21:32:23.460

Solution (credits go to Victor Perrier) taken from the shinyWidgets issue created by the asker.

Text can be roteted with nothing more than CSS. The class .irs-grid-text identifies the labels of the sliderTextInput widget. With transform the text can be rotated so that it does not overlap.

library(shinydashboard)
library(shinyWidgets)
library(shiny)


ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    tags$head(tags$style(
      type = "text/css", 
      ".irs-grid-text {font-size: 12pt !important; transform: rotate(-90deg) translate(-30px);"
    )),
    fluidRow(
      box(uiOutput("month_selection"), height = "200px")
    )
  )
)

server <- function(input, output) {
  output$month_selection <- renderUI({
    sliderTextInput(
      inputId = "month_select",
      label = "",
      grid = TRUE, 
      force_edges = TRUE,
      choices = seq(from = as.Date("2017-01-01"), to = as.Date("2019-12-31"), by = 30)
    )
  })
}

shinyApp(ui, server)

Avoid overlapping text in sliderTextInput

1 Answers1