目标

我需要使用一个或多个textInput来填充XML文件，我使用add按钮生成（第一个输入已经在应用程序启动时生成）。添加按钮在XML中创建一个新的空节点;删除按钮将其删除。生成的textInput中的信息应复制到相应的节点中，如下例所示：

第一项：_____ txt1 _______

第2项：_____ txt2 _______

第3项：_____ txt3 _______

XML文件：

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

我的尝试

使用以下代码，我可以添加/删除textInput元素以及XML文件中的节点。我不知道如何使用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)

任何提示（功能，例子等）？

谢谢

Answer 1

我认为这更像是xml2而不是闪亮的东西。

我刚刚修改了你的例子，利用

xml_new_root修复根文档
xml_add_child使用额外的arg文本（itemID）来更轻松地添加子节点

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)

R：如何在Shiny中处理动态生成的输入

目标

我的尝试

1 个答案: