Сохранять текстовый ввод пользовательского интерфейса после добавления или удаления входов

Я создаю небольшой пользовательский интерфейс, в котором пользователь войдет в строку splitLayout текста, которая строит инструкцию (не нужна для этого вопроса), чтобы решить загадку.

Первый вход

Однако, если пользователь решает, что ему нужна строка дополнительная строка или меньше для решения головоломки, я бы хотел добавить или удалить новую строку входов для НЕ удаляйте оставшиеся строки ввода.

Вторая попытка ввода * серый является заполнителем.

Как я могу достичь наилучшего результата:

введите описание изображения здесь

Пожалуйста, найдите мой подстриженный код ниже. Спасибо за ваш вклад.

library(shiny)

# Define UI
ui <- fluidPage(
  # Application title
  titlePanel("Identify A, B and C"),
  sidebarLayout(
    sidebarPanel(width = 5,
                 helpText("Present a statement and receive a response: 1 is a Knight who always tells the truth, 2 is a Knave who always lies, and 3 is a Normal who can do either."),
                 # Number of Questions
                 numericInput(inputId = "Questions", label = "Number of Questions", 
                              value = 1, min = 1, max = 10, step = 1),
                 splitLayout(cellWidths = c("25%","70%"), 
                             style = "border: 1px solid silver;",
                             cellArgs = list(style = "padding: 3px"),
                             uiOutput("textQuestions"), uiOutput("textQuestions2"))
    ),
    mainPanel(
      # Right hand side output
    )
  )
)

# Define server logic 
server <- function(input, output) {
  ####### I don't want these to delete initially everytime??
  output$textQuestions <- renderUI({
    Questions <- as.integer(input$Questions)
    lapply(1:Questions, function(i) {
      textInput(inputId = paste0("Who", i), label = paste0(i, ". Ask:"), placeholder = "A")
    })
  })
  ########
  output$textQuestions2 <- renderUI({
    Questions <- as.integer(input$Questions)
    lapply(1:Questions, function(i) {
      textInput(inputId = paste0("Q", i) , label = paste0("Logic:"), 
                value = "", placeholder = "A == 1 & (B != 2 | C == 3)")
    })
  })
  ######
}

# Run the application 
shinyApp(ui = ui, server = server)

Ответ 1

Похоже, кто-то уже дал вам ответ, используя uiOutput + renderUI, поэтому я собираюсь перейти на другой маршрут: используя insertUI и removeUI.

Вместо ввода числового ввода для "количества вопросов" я заменил его кнопкой "добавить вопрос", а другой - "удалить вопрос". У меня есть переменная, отслеживающая количество вопросов. При каждом нажатии "добавить вопрос" мы добавляем одну строку. Когда нажата кнопка "удалить вопрос", мы удаляем последнюю строку.

Здесь код:

library(shiny)

# Define UI
ui <- fluidPage(
  # Application title
  titlePanel("Identify A, B and C"),
  sidebarLayout(
    sidebarPanel(
      width = 5,
      helpText("Present a statement and receive a response: 1 is a Knight who always tells the truth, 2 is a Knave who always lies, and 3 is a Normal who can do either."),
      # Buttons to add/remove a question
      actionButton("add", "Add question"),
      actionButton("remove", "Remove question"),
      div(id = "questions",
          style = "border: 1px solid silver;")
    ),
    mainPanel(
      # Right hand side output
    )
  )
)

# Define server logic 
server <- function(input, output) {
  # Keep track of the number of questions
  values <- reactiveValues(num_questions = 0)

  # Add a question
  observeEvent(input$add, ignoreNULL = FALSE, {
    values$num_questions <- values$num_questions + 1
    num <- values$num_questions
    insertUI(
      selector = "#questions", where = "beforeEnd",
      splitLayout(
        cellWidths = c("25%","70%"), 
        cellArgs = list(style = "padding: 3px"),
        id = paste0("question", num),
        textInput(inputId = paste0("Who", num),
                  label = paste0(num, ". Ask:"),
                  placeholder = "A"),
        textInput(inputId = paste0("Q", num) ,
                  label = paste0("Logic:"),
                  placeholder = "A == 1 & (B != 2 | C == 3)")
      )
    )
  })

  # Remove a question
  observeEvent(input$remove, {
    num <- values$num_questions
    # Don't let the user remove the very first question
    if (num == 1) {
      return()
    }
    removeUI(selector = paste0("#question", num))
    values$num_questions <- values$num_questions - 1
  })


}

# Run the application 
shinyApp(ui = ui, server = server)

ИЗМЕНИТЬ

OP запросил способ получить пользовательский ввод на основе номера вопроса. Для этого:

  • Добавьте в интерфейс пользователя следующее:

    numericInput("question_num", "Show question number", 1),
    textOutput("question")
    
  • Добавьте на сервер следующее

    get_question <- function(q) {
      paste(
        input[[paste0("Who", q)]],
        ":",
        input[[paste0("Q", q)]]
      )
    }
    
    output$question <- renderText({
      get_question(input$question_num)
    })
    

Ответ 2

Вы можете сохранить его в реактивном значении:

  global <- reactiveValues(ask = c(), logic = c())

  observe({
    Questions <- as.integer(input$Questions)
    lapply(1:Questions, function(i) {
      inputVal <- input[[paste0("Who", i)]]
      if(!is.null(inputVal)){
        global$logic[i] <- inputVal
      }
      inputValQ <- input[[paste0("Q", i)]]
      if(!is.null(inputValQ)){
        global$ask[i] <- inputValQ
      }
    })
  })

Это даст следующий пример для примера: В качестве побочного эффекта значения также сохраняются, если вход был удален и затем повторно принят.

library(shiny)

# Define UI
ui <- fluidPage(
  # Application title
  titlePanel("Identify A, B and C"),
  sidebarLayout(
    sidebarPanel(width = 5,
                 helpText("Present a statement and receive a response: 1 is a Knight who always tells the truth, 2 is a Knave who always lies, and 3 is a Normal who can do either."),
                 # Number of Questions
                 numericInput(inputId = "Questions", label = "Number of Questions", 
                              value = 1, min = 1, max = 10, step = 1),
                 splitLayout(cellWidths = c("25%","70%"), 
                             style = "border: 1px solid silver;",
                             cellArgs = list(style = "padding: 3px"),
                             uiOutput("textQuestions"), uiOutput("textQuestions2"))
    ),
    mainPanel(
      # Right hand side output
    )
  )
)

# Define server logic 
server <- function(input, output) {
  global <- reactiveValues(ask = c(), logic = c())

  observe({
    Questions <- as.integer(input$Questions)
    lapply(1:Questions, function(i) {
      inputVal <- input[[paste0("Who", i)]]
      if(!is.null(inputVal)){
        global$ask[i] <- inputVal
      }
      inputValQ <- input[[paste0("Q", i)]]
      if(!is.null(inputValQ)){
        global$logic[i] <- inputValQ
      }
    })
  })
  ####### I don't want these to delete initially everytime??
  output$textQuestions <- renderUI({
    Questions <- as.integer(input$Questions)
    lapply(1:Questions, function(i) {
      textInput(inputId = paste0("Who", i), label = paste0(i, ". Ask:"), placeholder = "A", value = global$ask[i])
    })
  })
  ########
  output$textQuestions2 <- renderUI({
    Questions <- as.integer(input$Questions)
    lapply(1:Questions, function(i) {
      textInput(inputId = paste0("Q", i) , label = paste0("Logic:"), value = global$logic[i],
                placeholder = "A == 1 & (B != 2 | C == 3)")
    })
  })
  ######
}

# Run the application 
shinyApp(ui = ui, server = server)