Вложенный uiOutput внутри Ршины - PullRequest
Новая
       6

Вложенный uiOutput внутри Ршины

0 голосов
/ 07 января 2020

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

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

Однако ответы в этих панелях должны генерировать больше интерфейса внутри панели, из которой они были сгенерированы, и в этом заключается проблема ... вложение 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)

1 Ответ

1 голос
/ 07 января 2020

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

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)
...