Search code examples
rshinysliderdry

Avoid DRY with 13 sliderInputs and 13 textInputs

I have this simple app: Here with the slider input we choose a number and put it into text input and vice versa. The output is given also in a dataframe.

I would like to do this not only for 3 letters like here (A, B, C). I would like to automate the creation of such sliders and textput 13 times e.g. (A, B, C ..., K,L,M). Where A to K is in a vector to select.

I could add 10 more times the code but I want to automate the process:

How could I avoid to repeat the as #REPEATED and as #ForA, #ForB, #ForC marked code:

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
sidebarLayout(
    
    # Sidebar to demonstrate various slider options ----
    sidebarPanel(width = 4,
                 setSliderColor(c("DeepPink ", "#FF4500", "Teal"), c(1, 2, 3)),
                 # Input: Simple integer interval ----
                 div(class = "label-left",
                     
                     #REPEATED----------------------------------------------------
                     div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput("a", "A", min = 0, max = 3, value = 0, width = "250px")),
                     div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput("txt_a", label = NULL, value = 0, width = "40px" )),
                     
                     div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput("b", "B", min = 0, max = 3,value = 0, width = "250px")),
                     div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput("txt_b", label = NULL, value = 0, width = "40px" )),
                     
                     div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput("c", "C", min = 0, max = 3,value = 0, width = "250px")),
                     div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput("txt_c", label = NULL, value = 0, width = "40px" )),
                     #REPEATED------------------------------------------------------------------------------------------------------------------------
                 )
    ),
    
    # Main panel for displaying outputs ----
    mainPanel(
      titlePanel("Sliders"),
      # Output: Table summarizing the values entered ----
      tableOutput("values")
      
    )
  )
)
server <- function(input, output, session) {
  
  # For A----------------------------------------------------------------------
  observeEvent(input$txt_a,{
    if(as.numeric(input$txt_a) != input$a)
    {
      updateSliderInput(
        session = session,
        inputId = 'a',
        value = input$txt_a
      ) # updateSliderInput
    }#if
  })
  observeEvent(input$a,{
    if(as.numeric(input$txt_a) != input$a)
    {
      updateTextInput(
        session = session,
        inputId = 'txt_a',
        value = input$a
      ) # updateTextInput
      
    }#if
  })
  
  # For B----------------------------------------------------------------------
  observeEvent(input$txt_b,{
    if(as.numeric(input$txt_b) != input$b)
    {
      updateSliderInput(
        session = session,
        inputId = 'b',
        value = input$txt_b
      ) # updateSliderInput
    }#if
  })
  observeEvent(input$b,{
    if(as.numeric(input$txt_b) != input$b)
    {
      updateTextInput(
        session = session,
        inputId = 'txt_b',
        value = input$b
      ) # updateTextInput
      
    }#if
  })
  
  #For C----------------------------------------------------------------------
  # For A
  observeEvent(input$txt_c,{
    if(as.numeric(input$txt_c) != input$c)
    {
      updateSliderInput(
        session = session,
        inputId = 'c',
        value = input$txt_c
      ) # updateSliderInput
    }#if
  })
  observeEvent(input$c,{
    if(as.numeric(input$txt_c) != input$c)
    {
      updateTextInput(
        session = session,
        inputId = 'txt_c',
        value = input$c
      ) # updateTextInput
      
    }#if
  })
  
  
  # Reactive expression to create data frame of all input values ----
  sliderValues <- reactive({
    
    data.frame(
      Name = c("A",
               "B",   
               "C"),
      Value = as.character(c(input$a,
                             input$b,
                             input$c
                            )),
      stringsAsFactors = FALSE)
    
  })
 
  # Show the values in an HTML table ----
  output$values <- renderTable({
    sliderValues()
  }) 
}
shinyApp(ui, server)

enter image description here

Solution

  • You can return lists of html objects and reactive components:

    ui <- fluidPage(
sidebarLayout(
    # Sidebar to demonstrate various slider options ----
    sidebarPanel(width = 4,
                 setSliderColor(c("DeepPink ", "#FF4500", "Teal"), c(1, 2, 3)),
                 # Input: Simple integer interval ----
                 div(class = "label-left",
                     Map(function(id, lbl) {
                       list(
                         div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput(id, lbl, min = 0, max = 3, value = 0, width = "250px")),
                         div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput(paste0("txt_", id), label = NULL, value = 0, width = "40px" ))
                       )
                     }, c("a", "b", "c"), c("A", "B", "C"))
                 )
    ),
    # Main panel for displaying outputs ----
    mainPanel(
      titlePanel("Sliders"),
      # Output: Table summarizing the values entered ----
      tableOutput("values")

    )
  )
)
server <- function(input, output, session) {
  Map(function(id) {
    list(
      observeEvent(input[[paste0("txt_", id)]], {
        if(as.numeric(input[[paste0("txt_", id)]]) != input[[id]])
        {
          updateSliderInput(
            session = session,
            inputId = id,
            value = input[[paste0("txt_", id)]]
          ) # updateSliderInput
        }#if
      }),
      observeEvent(input[[id]], {
        if(as.numeric(input[[paste0("txt_", id)]]) != input[[id]])
        {
          updateTextInput(
            session = session,
            inputId = paste0("txt_", id),
            value = input[[id]]
          ) # updateTextInput

        }#if
      })
    )
  }, c("a", "b", "c"))

  # Reactive expression to create data frame of all input values ----
  sliderValues <- reactive({

    data.frame(
      Name = c("A",
               "B",
               "C"),
      Value = as.character(c(input$a,
                             input$b,
                             input$c
                            )),
      stringsAsFactors = FALSE)

  })

  # Show the values in an HTML table ----
  output$values <- renderTable({
    sliderValues()
  })
}

    (I used Map the second time only for consistency, lapply works equally well.)