Вложенный uiOutput в RShiny

Короче говоря, я верю, что мне нужно вложить uiOutputs вместе, и я не могу придумать для этого отличный способ.

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

Однако ответы на этих панелях должны генерировать больше пользовательского интерфейса внутри панели, из которой они были сгенерированы, и в этом заключается проблема ... вложение uiOutputs. Я попытался представить кратчайший возможный пример ниже с комментариями - и обратите внимание, что второй вызов uiOutput работает, если я указываю панель, для которой он должен работать (в данном случае "oh_lawd_1").

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

library(shiny)
library(shinyWidgets)

ui <- fluidPage( #UI

  column(6, offset = 3,
    sliderInput(inputId = "my_slider",     # slider to choose number of panels
                label = "Choose Panels to be Displayed",
                min = 0, max = 5, value = 1),
    uiOutput(outputId = "update_panels")   # ui output to create panels

  )
)

server <- function(input, output, session) { #Server

  output$update_panels <- renderUI({     # rendering all the panels called for by user

    panels <- input$my_slider

    if(panels == 0){
      return("No panels being displayed")# returning 0 if none selected
    } else {
      our_ui <- list()                   # creating a list to store a standard panel
      for(i in 1:panels){
        button_id <- paste("button_id", i, sep = "_") # a unique id for each panel's radiobuttons
        oh_lawd   <- paste("oh_lawd", i, sep = "_")         # a unique id for each panel's uiOutput
        update    <- wellPanel(paste("Well Panel #", i),    # "update" is what each panel should START OFF looking like
                            radioButtons(inputId = button_id, 
                                         label = "Choose a pill", 
                                         choices = c("Red Pill", "Blue Pill")),
                            uiOutput(oh_lawd))     # this part is the issue - I would like to update individual panels with a 
                                                   # radio button selection specific to a choice in each panel... a nested uiOutput
        our_ui <- list(our_ui, update)
      }}
    our_ui})


  output$oh_lawd_1 <- renderUI({     # this works for the first... but I need to somehow create one of these for each based on
                                   # number of panels and the choice in each panel
    if(input$button_id_1 == "Red Pill"){
      radioButtons("first_output", "Next Choices", choices = c("I'm a brave boi", "Knowledge schmoledge"))
    } else {
      radioButtons("first_output", "Next Choices", choices = c("Gimme dat ignorance", "Mhmm yea") )
    }
  })             

}

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

r shiny shiny-reactivity
person Brennan Beal    schedule 07.01.2020    source источник

Ответы (1)


arrow_upward
2
arrow_downward

Это то, что ты хочешь? Я не уверен.

library(shiny)
library(shinyWidgets)

ui <- fluidPage( #UI

  column(6, offset = 3,
         sliderInput(inputId = "my_slider",     # slider to choose number of panels
                     label = "Choose Panels to be Displayed",
                     min = 0, max = 5, value = 1),
         uiOutput(outputId = "update_panels")   # ui output to create panels

  )
)

server <- function(input, output, session) { #Server

  output$update_panels <- renderUI({     # rendering all the panels called for by user

    panels <- input$my_slider

    if(panels == 0){
      return("No panels being displayed")# returning 0 if none selected
    } else {
      our_ui <- list()                   # creating a list to store a standard panel
      for(i in 1:panels){
        button_id <- paste("button_id", i, sep = "_") # a unique id for each panel's radiobuttons
        oh_lawd   <- paste("oh_lawd", i, sep = "_")         # a unique id for each panel's uiOutput
        update    <- wellPanel(paste("Well Panel #", i),    # "update" is what each panel should START OFF looking like
                               radioButtons(inputId = button_id, 
                                            label = "Choose a pill", 
                                            choices = c("Red Pill", "Blue Pill")),
                               uiOutput(oh_lawd))     # this part is the issue - I would like to update individual panels with a 
        # radio button selection specific to a choice in each panel... a nested uiOutput
        our_ui <- list(our_ui, update)
      }}
    our_ui})

  observeEvent(input$my_slider, {
    lapply(seq_len(input$my_slider), function(i){
      uiID <- paste0("oh_lawd_", i)
      buttonID <- paste0("button_id_", i)
      radioID <- paste0("radio_id_", i)
      output[[uiID]] <- renderUI({
        if(input[[buttonID]] == "Red Pill"){
          choices <- c("I'm a brave boi", "Knowledge schmoledge")
        }else{
          choices <- c("Gimme dat ignorance", "Mhmm yea")
        }
        radioButtons(radioID, "Next Choices", choices = choices)
      })
    })
  })

}

# Run the application 
shinyApp(ui = ui, server = server)
person Stéphane Laurent    schedule 07.01.2020
comment
Замечательно - похоже, я был близок, но не мог понять, как / где хранить все созданные пользовательские интерфейсы после цикла. Сохранение его в Output [[uiID]] в этом случае имеет смысл и настолько очевидно. Спасибо, что нашли время ответить! (также, чтобы он создавался как зависимость от ползунка - это то, о чем я не думал) - person Brennan Beal; 07.01.2020