简体   繁体   中英

R: how to handle dynamically generated inputs in Shiny

I'm struggling in dealing with the inputs I generate using the insertUI function.

Goal

I need to fill a XML file using one or more textInput I generate with add button (the first input is already generated when the app starts). The add button create a new empty node in the XML; the remove button remove it. The information in generated textInput should be copied in the respective node as in the following example:

First item: _____txt1_______

Item 2: _____txt2_______

Item 3: _____txt3_______

XML file:

<items>
 <item>txt1<item>
 <item>txt2<item>
 <item>txt3<item>
</items>

My attempt

Using the following code I'm able to add/remove textInput element as well as nodes in the XML file. I have no idea how to fill the nodes with the textInput.

library(shiny)
library(xml2)

xml <-
  "<?xml version=\"1.0\" encoding=\"UTF-8\"?><items><item/></items>"
doc <- read_xml(xml)

# Define UI ----
ui <- fluidPage(
  # Create the first Text input
  tags$div(
    id = 'items',
    textInput(
      inputId = "item1",
      label = "First item",
      width = "100%"
    )
  ),
  # Create the add/remove buttons
  actionButton("addBtn", "Add"),
  actionButton("removeBtn", "Remove"),

  # Output XML
  h4("XML Code"),
  htmlOutput("xml")
)

# Define server logic ----
server <- function(input, output) {
  inserted <<- c("item1")
  btn <<- 2
  # Observe the add button
  observeEvent(input$addBtn, {
    itemID <- paste0("item", btn)
    insertUI(selector = "#items",
             ui = tags$div(
               id = itemID,
               textInput(
                 inputId = itemID,
                 label = paste("Item", btn),
                 width = "100%"
               )
             ))
    xml_add_sibling(xml_find_all(doc, "item[last()]"), "item")
    btn <<- btn + 1
    inserted <<- c(inserted, itemID)
  })

  # Observe the remove button
  observeEvent(input$removeBtn, {
    itemID <- paste0("item",btn-1)
    cat(itemID, sep="\n")
    if (length(inserted) > 1) {
      removeUI(selector = paste0("#", itemID))

      xml_remove(xml_find_all(doc, "item[last()]"))
      inserted <<- inserted[-(btn - 1)]
      btn <<- btn - 1
    }
  })

  # Render the xml output
  output$xml <- renderText({
    # ugly way to update each press button
    input$addBtn
    input$removeBtn

    # XML convertion to print it in ui
    docConv <- as.character(doc)
    docConv <- gsub("<", "&lt;", docConv)
    docConv <- gsub(">", "&gt;", docConv)
    docConv <- gsub(" ", "&nbsp;", docConv, fixed = T)
    docConv <- gsub("\\n", "<br/>", docConv)
    HTML(docConv)
  })
}

# Run the app ----
shinyApp(ui = ui, server = server)

Any hint (functions, examples, etc.)?

Thank you

I think this is more of an xml2 than Shiny thing.

I just barely modified your example, leveraging

library(shiny)
library(xml2)

doc <- xml_new_root("items")

# Define UI ----
ui <- fluidPage(
  # Create the first Text input
  tags$div(id = 'items'),
  # Create the add/remove buttons
  actionButton("addBtn", "Add"),
  actionButton("removeBtn", "Remove"),

  # Output XML
  h4("XML Code"),
  htmlOutput("xml")
)

# Define server logic ----
server <- function(input, output) {
  inserted <<- c()
  btn <<- 1
  # Observe the add button
  observeEvent(input$addBtn, {
    itemID <- paste0("item", btn)
    insertUI(selector = "#items",
             ui = tags$div(
               id = itemID,
               textInput(
                 inputId = itemID,
                 label = paste("Item", btn),
                 width = "100%"
               )
             ))
    xml_add_child(doc, "item", itemID)
    btn <<- btn + 1
    inserted <<- c(inserted, itemID)
  })

  # Observe the remove button
  observeEvent(input$removeBtn, {
    itemID <- paste0("item", btn-1)
    cat(itemID, sep="\n")
    if (length(inserted) > 0) {
      removeUI(selector = paste0("#", itemID))

      xml_remove(xml_find_all(doc, "item[last()]"))
      inserted <<- inserted[-(btn - 1)]
      btn <<- btn - 1
    }
  })

  # Render the xml output
  output$xml <- renderText({
    # ugly way to update each press button
    input$addBtn
    input$removeBtn

    # XML convertion to print it in ui
    docConv <- as.character(doc)
    docConv <- gsub("<", "&lt;", docConv)
    docConv <- gsub(">", "&gt;", docConv)
    docConv <- gsub(" ", "&nbsp;", docConv, fixed = T)
    docConv <- gsub("\\n", "<br/>", docConv)
    HTML(docConv)
  })
}

# Run the app ----
shinyApp(ui = ui, server = server)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM