RanonKahn
RanonKahn

Reputation: 862

Dynamic Form in RShiny

This is an extension of an earlier query [Creating asymmetric layouts involving rows and column in Shiny. I am trying to create a dynamic UI output. Need suggestions to fix the layout by grouping the dropdown menu and the textboxes together for each 'Topic', and also on how to capture the data from the various dropdown and textboxes dynamically created.

This is the modified code from an earlier query [How to add/remove input fields dynamically by a button in shiny:

library(shiny)

ui <- shinyUI(fluidPage(
sidebarPanel(
actionButton("add_btn", "Add Textbox"),
actionButton("rm_btn", "Remove Textbox"),
textOutput("counter")
),
mainPanel(
  fluidRow(column(6,uiOutput("selectbox_ui"), offset = 0), 
 column(6,fluidRow(column(6,uiOutput("textbox_ui1"), uiOutput("textbox_ui2"))),
    fluidRow(column(6,uiOutput("textbox_ui3"), uiOutput("textbox_ui4"),offset = 0)), offset = 0)
  )
)))

server <- shinyServer(function(input, output, session) { session$onSessionEnded(stopApp)

# Track the number of input boxes to render
counter <- reactiveValues(n = 0)

observeEvent(input$add_btn, {counter$n <- counter$n + 1})
observeEvent(input$rm_btn, {if (counter$n > 0) counter$n <- counter$n - 1})

output$counter <- renderPrint(print(counter$n))

textboxes1 <- reactive({n <- counter$n
 if (n > 0) 
  {lapply(seq_len(n), function(i) {textInput(inputId = paste0("textin1", i),label = paste0("Textbox_A_Topic", i), value = "Hello World!")})}
 })

textboxes2 <- reactive({n <- counter$n
  if (n > 0) 
   {lapply(seq_len(n), function(i) {textInput(inputId = paste0("textin2", i),label = paste0("Textbox_B_Topic", i), value = "Hello World!")}    )}
 })
textboxes3 <- reactive({n <- counter$n
  if (n > 0) 
   {lapply(seq_len(n), function(i) {textInput(inputId = paste0("textin3", i),label = paste0("Textbox_C_Topic", i), value = "Hello World!")}    )}
 })
textboxes4 <- reactive({n <- counter$n
  if (n > 0) 
   {lapply(seq_len(n), function(i) {textInput(inputId = paste0("textin4", i),label = paste0("Textbox_D_Topic", i), value = "Hello World!")}     )}
 })
selectboxes <- reactive({n <- counter$n
   if (n > 0) 
    {lapply(seq_len(n), function(i) {selectInput(inputId = paste0("selectTopic", i), label = paste0("Topic", i), 
                                                 choices = c("one", "two", "three"), selected = "two", multiple = FALSE)})}
 })

output$textbox_ui1 <- renderUI(textboxes1())
output$textbox_ui2 <- renderUI({textboxes2() })
output$textbox_ui3 <- renderUI({textboxes3() })
output$textbox_ui4 <- renderUI({textboxes4() })
output$selectbox_ui <- renderUI({selectboxes()})

})

Upvotes: 0

Views: 853

Answers (1)

Mikko Marttila
Mikko Marttila

Reputation: 11878

For solving your layout problem, it helps to think about all of the elements related to a single topic (i.e. the dropdown menu and the four text inputs) as forming a single block of elements. Then find a way to create one of these blocks (probably a good idea to extract the process into a function, too), and proceed to stack the blocks to achieve the desired result.

A function for creating a complete topic block in your example could look something like this:

topic_ui <- function(i) {

  # render all elements related to a single topic into one div

  fluidRow(

    # drop-down select menu on the left
    column(width = 6, offset = 0,
      selectInput(
        inputId = paste0("selectTopic", i),
        label   = paste0("Topic", i),
        choices = c("one", "two", "three"),
        selected = "two",
        multiple = FALSE
      )
    ),

    # text boxes on the right
    column(width = 6, offset = 0,
      lapply(LETTERS[1:4], function(l) {
        textInput(
          inputId = paste0("textin", l, i),
          label   = paste0("Textbox_", l, "_Topic", i),
          value   = "Hello World!"
        )
      })
    )

  )

}

Now it's a matter of modifying the server to work with the new topic ui creator function:

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

  session$onSessionEnded(stopApp)

  # Track the number of input boxes to render
  counter <- reactiveValues(n = 0)

  observeEvent(input$add_btn, {
    counter$n <- counter$n + 1
  })

  observeEvent(input$rm_btn, {
    if (counter$n > 0)
      counter$n <- counter$n - 1
  })

  output$counter <- renderPrint(print(counter$n))

  # render a number of topic ui elements based on the counter,
  # each consisting of a selectInput and four textInputs
  topics <- reactive({
    n <- counter$n
    if (n > 0)
      lapply(seq_len(n), topic_ui)
  })

  output$topic_ui <- renderUI(topics())

})

And finally, the ui side can also be simplified as a result:

ui <- shinyUI(fluidPage(

  sidebarPanel(

    actionButton("add_btn", "Add Textbox"),
    actionButton("rm_btn", "Remove Textbox"),
    textOutput("counter")

  ),

  mainPanel(

    # dynamically created ui elements

    uiOutput("topic_ui")

  )

))

As for capturing input from the dynamic elements, in principle you would just do it the same way as for any static input element: refer to it via the name given in the inputId argument. As a complication, I suppose you would have to include some checks to see if the dynamic element exists first, though. If you expand your example case to include something you would like to do with the dynamic input, I can try to have a look again!

Upvotes: 2

Related Questions