0

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()})

})
RanonKahn
  • 853
  • 10
  • 34

1 Answers1

2

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!

Mikko Marttila
  • 10,972
  • 18
  • 31
  • The issue I am facing now is, after filling in the text boxes, and when I click on the add button to add more data , a fresh set of text boxes are created with 'Hello world' value replacing the entered value in the text boxes. – RanonKahn Aug 24 '17 at 22:40
  • I can think of two ways to get around it: save the current state of all the input elements in a reactive list and then use those states to recreate the old input when adding or removing boxes (as I speculate at the end of https://stackoverflow.com/a/31457114/4550695); or if you have maximum amount of topics, just create all of them at once and use `shinyjs` to dynamically show and hide them according to the counter value, rather than actually adding and removing them. – Mikko Marttila Aug 25 '17 at 06:36
  • I am going with the second option. – RanonKahn Aug 25 '17 at 16:01
  • Can you please have a look at this https://stackoverflow.com/questions/46136875/how-to-interactively-update-default-selected-values-in-r-shiny-input-widget ? – RanonKahn Sep 10 '17 at 20:44