вложенный интерактивный интерфейс в блестящем - PullRequest
Новая
       20

вложенный интерактивный интерфейс в блестящем

0 голосов
/ 02 апреля 2020

Я пытаюсь создать интерактивный пользовательский интерфейс с блестящей. На основе первого выбора он создает набор вкладок, и в этом наборе вкладок на основе второго выбора создается другой пользовательский интерфейс. Приведенный ниже код работает, но я не могу понять, как я мог бы заменить X = 1: 10 на 1: n () в строке 82 ...

Спасибо за любые предложения:)

(но, пожалуйста, будь хорошим, потому что я большой плач) 

library(shiny)


# constants for example

factors <- LETTERS[1:10]

factor_values <- c()
for(i in factors){
  factor_values[[i]] <- paste0(i,1:5)    
}

samples <- paste0("sample_",1:10)

# UI

ui <- fluidPage(
  h3("Choose factors"),
  selectizeInput("factor","Select all known factors:",factors, multiple=TRUE),
  tags$br(),
  uiOutput("tabset"),
  actionButton("btn","print stuff that's happening, cause wtf...")
)



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

  factor_val_list <- reactive({
    req(input$factor)
    f <- input$factor
    l <- c()
    for( i in 1:length(f) ){
      l[[i]] <- factor_values[[f[i]]]
    }
    return(l)
  })


  ui_tabset_factor <- reactive({
    req(input$factor)
    # list of chosen factors 
    factor <- input$factor
    l <- c()
    for(i in 1:length(factor)){
      tab <- paste0(
        "tabPanel('",factor[i],"', tags$br(),
        selectizeInput(
        inputId = 'fv_", i,"',
        label=p('Select all different values for the factor in the experiment: '),
        choices=factor_val_list()[[",i,"]], 
        multiple=TRUE),
        checkboxInput('",paste0("check_",i),"','Check this box when the list is complete.'),
        tags$br(),
        p('Assign the samples to the right category:'),
        tags$div(id = 'placeholder_",i,"') 
      )")
      # create list of tabpanels from chosen factors
      l <- append(l, tab)
    }
    # seperate them with comma's
    tabs <- paste(l, collapse=",")
    # create tabsetpanel with created tabs
    ui <- paste0("tabsetPanel(type = 'tabs',",tabs,")")
  })


  output$tabset <- renderUI({
    # renderUI from text creating tabsetpanel
    eval(parse(text=ui_tabset_factor()))
  })


  n <- reactive({
    req(input$factor)
    length(input$factor)
  })

  # insert UI 
  lapply(
    X = 1:10,
    FUN = function(i){
      observeEvent(input[[paste0("check_",i)]], {
        id <- paste0('div_', i)
        if(input[[paste0("check_",i)]] == 1){
          insertUI(
            selector = paste0('#placeholder_',i),
            ## wrap element in a div with id for ease of removal
            ui = tags$div(
              selectInput(paste0("sample_",i),"Choose sample",samples),
              id = id
            )
          )
        } else {
          removeUI(
            # pass in appropriate div id
            selector = paste0('#div_',i)
          )

        }
      }, ignoreInit = TRUE)
    }
  )


  observeEvent(input$btn,{
    print(n())
  })

  session$onSessionEnded(function(session){
    # stop the application
    stopApp()
  })


}
shinyApp(ui = ui, server = server)
...