Блог

Прямо сейчас у меня есть приложение, которое вставляет пользовательский интерфейс при нажатии кнопки. На экране по умолчанию видна только кнопка. Я должен нажать на кнопку, чтобы вставить новые строки.

Я пытаюсь отобразить одну строку на экране по умолчанию.

Вот как выглядит экран по умолчанию:

Но я хочу, чтобы экран по умолчанию выглядел так, когда одна строка уже вставлена:

Я попытался переместить ui_placeholder (ы) для рендеринга на главном сервере, но это не сработало.

Код для приложения:

 library(shiny)

newlist <- as.list(c("LV1", "LV2", "x1", "x2", "x3", "x4", "x5", "x6"))

symbol <- as.list(c("=~", "~"))

row_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    
    column(2,
           uiOutput(ns("ui_placeholder"))),
    column(2,
           uiOutput(ns("ui_placeholder3"))),
    
    column(2, 
           uiOutput(ns("ui_placeholder2")))
  )
} 


row_server <- function(input, output, session) {
  
  return_value <- reactive({paste(input$variable1, input$symbol1, paste(input$variable2, collapse = " "))})
  ns <- session$ns
  output$ui_placeholder <- renderUI({
    
    selectInput(ns("variable1"), "LV:", choices = c(' ', newlist), selected = NULL)
    
  })
  
  output$ui_placeholder2 <- renderUI({
    selectInput(ns("variable2"), "Ind:", choices = c(' ', names(HolzingerSwineford1939)), selected = NULL, multiple = TRUE)
  })
  
  output$ui_placeholder3 <- renderUI({
    selectInput(ns("symbol1"), "Type", choices = c(' ', symbol), selected = NULL)
  })
  
  list(return_value = return_value) 
}

ui <- fluidPage(  
  div(id="placeholder"),
  actionButton("addLine", "  LV"),
  verbatimTextOutput("out"),
  verbatimTextOutput("listout5")
)



server <- function(input, output, session) {
  
  handler <- reactiveVal(list())
  observeEvent(input$addLine, {
    new_id <- paste("row", input$addLine, sep = "_")
    insertUI(
      selector = "#placeholder",
      where = "beforeBegin",
      ui = row_ui(new_id)
    )
    
    handler_list <- isolate(handler())
    new_handler <- callModule(row_server, new_id)
    handler_list <- c(handler_list, new_handler)
    names(handler_list)[length(handler_list)] <- new_id
    handler(handler_list)
  })
  
  outformula <- reactive({
    paste(sapply(handler(), function(handle) {
      paste0(handle(), collapse = " ")
    }), collapse="n")
  })
  
  output$out <- renderPrint({
    cat(outformula())
  })
  
 
}

shinyApp(ui, server)
  

Вы также можете использовать callModule и insertUI непосредственно в серверной функции. Этот код выполняется только один раз при запуске и показывает вам первую строку.

Я внес несколько изменений:

• Я использую reactiveValues вместо reactiveVal , особенно если вы имеете дело со списком, мне кажется, это проще
• однако первый добавленный элемент (при инициализации reactiveValues ) всегда является последним элементом, поэтому мне нужно выполнить дополнительную логику, чтобы правильно упорядочить outformula
• Поскольку я напрямую использую reactiveValuesToList с reactiveValues объектом, я должен использовать handle$return_value() вместо handle() in sapply , чтобы исправить измененную структуру реактивов.

 library(shiny)

newlist <- as.list(c("LV1", "LV2", "x1", "x2", "x3", "x4", "x5", "x6"))

symbol <- as.list(c("=~", "~"))

HolzingerSwineford1939 <- c(a = 1,
                            b = 2,
                            c = 3)

row_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    
    column(2,
           uiOutput(ns("ui_placeholder"))),
    column(2,
           uiOutput(ns("ui_placeholder3"))),
    
    column(2, 
           uiOutput(ns("ui_placeholder2")))
  )
} 


row_server <- function(input, output, session) {
  
  return_value <- reactive({paste(input$variable1, input$symbol1, paste(input$variable2, collapse = " "))})
  ns <- session$ns
  output$ui_placeholder <- renderUI({
    
    selectInput(ns("variable1"), "LV:", choices = c(' ', newlist), selected = NULL)
    
  })
  
  output$ui_placeholder2 <- renderUI({
    selectInput(ns("variable2"), "Ind:", choices = c(' ', names(HolzingerSwineford1939)), selected = NULL, multiple = TRUE)
  })
  
  output$ui_placeholder3 <- renderUI({
    selectInput(ns("symbol1"), "Type", choices = c(' ', symbol), selected = NULL)
  })
  
  list(return_value = return_value) 
}

ui <- fluidPage(  
  div(id="placeholder"),
  actionButton("addLine", "  LV"),
  verbatimTextOutput("out"),
  verbatimTextOutput("listout5")
)



server <- function(input, output, session) {
  
  handler <- reactiveValues(row_0 = callModule(row_server, "row_0"))
  insertUI(
    selector = "#placeholder",
    where = "beforeBegin",
    ui = row_ui("row_0")
  )
  
  observeEvent(input$addLine, {
    new_id <- paste("row", input$addLine, sep = "_")
    insertUI(
      selector = "#placeholder",
      where = "beforeBegin",
      ui = row_ui(new_id)
    )
    
    handler[[new_id]] <- callModule(row_server, new_id)
  })
  
  outformula <- reactive({
    current_list <- reactiveValuesToList(handler)
    
    if (length(current_list) == 1) {
      correct_index <- 1
    } else {
      correct_index <- c(length(current_list), 1:(length(current_list) - 1))
    }
    paste(sapply(current_list[correct_index], function(handle) {
      paste0(handle$return_value(), collapse = " ")
    }), collapse="n")
  })
  
  output$out <- renderPrint({
    cat(outformula())
  })
  
  
}

shinyApp(ui, server)