R에서 동적으로 생성 된 selectInput 상자에 대한 선택 업데이트 Shiny

Question

사용자가 새 selectInput 상자를 UI에 동적으로 추가 할 수있게 해주는 응용 프로그램에서 작업 중이며 모든 selectInput 상자에 데이터 집합의 열 이름을 사용하기를 원합니다. 그들의 '선택'으로 데이터 세트는 사용자가 선택해야하므로 selectInput 선택을 데이터 세트 선택의 변경에 반응하게 만들었습니다.

소리가 간단하지만 올바르게 작동하지 않는 것 같습니다. 처음 앱을 열면 첫 번째 selectInput은 비어 있습니다. 이것은 사용자가 자신의 데이터 세트를 업로드 할 수 있기를 원하기 때문에 괜찮습니다. 따라서 기본 데이터 세트는 NULL이됩니다 (여기서는 미리로드 된 데이터 세트를 사용하여 재현성을 사용하므로 약간 다릅니다).

나는 드롭 다운 선택 상자에서 '아이리스'는 (다른) 데이터 집합을 선택하고 '아이리스'데이터 세트의 열 이름이 자동으로 selectInput 상자 (표 1)에로드됩니다. 원하는대로 완벽하게 작동합니다.

다음, 나는 표 1에 더하기 기호를 클릭하여 새 selectInput 상자를 추가하고, 새로운 selectInput 상자가 옆에 (표 2)이 나타납니다. 내가 새로 만든 자식 selectInput 상자가 자동으로 데이터 세트의 열 이름을 사용하려면,하지만 난이 작업을 수행하는 방법을 알아낼 수 없습니다 : 여기

그리고

는 문제가있다. 새로운 selectInput 상자를 채울 수있는 유일한 방법은 데이터 집합 선택을 다시 변경하는 것이므로 바람직하지 않습니다. 여기

이 예에서 사용 된 코드입니다 :

library(shiny) 
library(datasets) 

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

    newNode <- function(id, parentId) { 
    node <- list(
     parent = parentId, 
     children = list() 
    ) 
    # Create the UI for this node 
    createSliceBox(id, parentId) 
    return(node) 
    } 

    createSliceBox <- function(id, parentId) { 
    # Div names 
    containerDivID <- paste0('container',id,'_div') 
    nodeDivID <- paste0('node',id,'_div') 
    childrenDivID <- paste0('children',id,'_div') 

    if (parentId == 0) { # Root node case 
     parentDivID <- 'allSliceBoxes' 
    } else { 
     parentDivID <- paste0('children',parentId,'_div') 
    } 

    # Input names 
    selectID <- paste0("sliceBoxSelect", id) 
    buttonID <- paste0("sliceBoxButton", id) 

    # Insert the UI element for the node under the parent's children_div 
    insertUI(
     selector = paste0('#',parentDivID), 
     where = 'afterBegin', 
     ui = tagList(
     tags$div(id=containerDivID, style='float:left', 
      tags$div(id=nodeDivID, style='float:left; margin: 5px; min-width:250px', 
      actionButton(buttonID, "", 
       icon("plus-circle fa-1x"), style="float:right; border:none; color:#00bc8c; background-color:rgba(0,0,0,0)"), 
      wellPanel(class="well well-sm", 
       selectInput(selectID, paste0("Table ", id, ", child of ", parentId, "."), c(''), multiple=FALSE) 
      ) 
     ), 
      tags$div(id=childrenDivID, style='float:left') # Container for children, starts empty 
     ), 
     tags$br('') 
    ) 
    ) 
    # Observer for selectors 
    observe(
     updateSelectInput(session, selectID, choices=names(d.Preview())) # Doesn't work as expected? 
    ) 
    } 

    ### CODE STARTS HERE 
    tags$head(tags$script(src="https://use.fontawesome.com/15c2608d79.js")) # Import FontAwesome for icons 

    # File upload 

    d.Preview <- reactive({ 
    switch(input$dataset, 
      "mtcars" = mtcars, 
      "iris" = iris, 
      "esoph" = esoph) 
    }) 

    # We'll store our nodes as a 1D list, so parent and child ID's are recorded as their indices in the list 
    sliceBox.data <- reactiveValues(display=list(), selected=list()) 
    rootNode <- newNode(1, 0) # Page loads with NULL first node, before input is chosen 
    sliceBox.tree <- reactiveValues(tree=list(rootNode)) 
    # Special case for loading data into first node, needs reactive parentData - not the case for children nodes 
    observeEvent(input$dataset, { 
    slice <- reactive({ 
     sliceData(d.Preview(), input$sliceBoxSelect1) 
    }) 
    # Creating data for the first node 
    sliceBox.data$display[[1]] <- reactive(slice()) 
    sliceBox.data$selected[[1]] = reactive({ 
     selectedRows <- input[[paste0("sliceBoxTable", 1, "_rows_selected")]] 
     filterData(d.Preview(), sliceBox.data$display[[1]](), selectedRows, input[[paste0("sliceBoxSelect",1)]]) 
    }) 

    }) 

    # Keep a total count of all the button presses (also used loosely as the number of tables created) 
    v <- reactiveValues(counter = 1L) 
    # Every time v$counter is increased, create new handler for the new button at id=v$counter 
    observeEvent(v$counter, { 
    parentId <- v$counter 
    buttonID <- paste0("sliceBoxButton", parentId) 

    # Button handlers to create new sliceBoxes 
    observeEvent(input[[buttonID]], { 
     v$counter <- v$counter + 1L 
     childId <- v$counter 
     # Note that because the ObserveEvents are run separately on different triggers, (childId != parentId+1) 

     # Create new child 
     sliceBox.tree$tree[[childId]] <- newNode(childId, parentId) 

     # Append new childId to parent's list of children 
     numChildren <- length(sliceBox.tree$tree[[parentId]]$children) 
     sliceBox.tree$tree[[parentId]]$children[numChildren+1] <- childId 
    }) 
    }) 

} 

ui <- fluidPage(theme = "bootstrap.css", 
    # Main display body 
    fluidRow(style="padding:5px", 
    selectInput("dataset", "Choose a dataset:", choices = c("mtcars", "iris", "esoph"), selected=NULL), 
    tags$div(uiOutput("allSliceBoxes"), style="padding:20px") 
) 
) 

shinyApp(ui = ui, server = server) 

희망의 사람이 도움을 줄 수, 거기에 온라인 selectInput에 관한 질문이 많이 있습니다하지만 난이 특정 문제에 대한 해결책을 발견하지 않았습니다 데.

Answer 1

우선, 새로운 매개 변수 choices을 newNode 및 createSliceBox에 추가했습니다.

newNode <- function(id, parentId, choices = NULL) { 
      ... 
      createSliceBox(id, parentId, choices) 
      ... 
      } 

createSliceBox <- function(id, parentId, choices) { ... } 

은 그 후, 함수 createSliceBox 내에는 I choices에 c('')에서 selectInputchoices의 파라미터를 변경.

createSliceBox <- function(id, parentId, choices) { 
    ... 
    selectInput(selectID, paste0("Table ", id, ", child of ", parentId, "."), choices, multiple=FALSE) # added choices 
    ... 
    } 

마지막으로, 아래로 아래 관찰자 내, 내가 그런데 newNode 기능

# Create new child 
sliceBox.tree$tree[[childId]] <- newNode(childId, parentId, choices = names(d.Preview())) # added choices 

---

에 실제 데이터 세트의 이름을 추가, 지금은 새로운 있다는 것을 알고하는 것이 좋다 기능 insertUI :

---

전체 예 :

library(shiny) 
library(datasets) 

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

    newNode <- function(id, parentId, choices = NULL) { # new parameter 
    node <- list(
     parent = parentId, 
     children = list() 
    ) 
    # Create the UI for this node 
    createSliceBox(id, parentId, choices) # new parameter 
    return(node) 
    } 

    createSliceBox <- function(id, parentId, choices) { 
    # Div names 
    containerDivID <- paste0('container',id,'_div') 
    nodeDivID <- paste0('node',id,'_div') 
    childrenDivID <- paste0('children',id,'_div') 

    if (parentId == 0) { # Root node case 
     parentDivID <- 'allSliceBoxes' 
    } else { 
     parentDivID <- paste0('children',parentId,'_div') 
    } 

    # Input names 
    selectID <- paste0("sliceBoxSelect", id) 
    buttonID <- paste0("sliceBoxButton", id) 

    # Insert the UI element for the node under the parent's children_div 
    insertUI(
     selector = paste0('#',parentDivID), 
     where = 'afterBegin', 
     ui = tagList(
     tags$div(id=containerDivID, style='float:left', 
       tags$div(id=nodeDivID, style='float:left; margin: 5px; min-width:250px', 
          actionButton(buttonID, "", 
             icon("plus-circle fa-1x"), style="float:right; border:none; color:#00bc8c; background-color:rgba(0,0,0,0)"), 
          wellPanel(class="well well-sm", 
            selectInput(selectID, paste0("Table ", id, ", child of ", parentId, "."), choices, multiple=FALSE) # added choices 
         ) 
       ), 
       tags$div(id=childrenDivID, style='float:left') # Container for children, starts empty 
     ), 
     tags$br('') 
    ) 
    ) 
    # Observer for selectors 
    observe(
     updateSelectInput(session, selectID, choices=names(d.Preview())) # Doesn't work as expected? 
    ) 
    } 

    ### CODE STARTS HERE 
    tags$head(tags$script(src="https://use.fontawesome.com/15c2608d79.js")) # Import FontAwesome for icons 

    # File upload 

    d.Preview <- reactive({ 
    switch(input$dataset, 
      "mtcars" = mtcars, 
      "iris" = iris, 
      "esoph" = esoph) 
    }) 

    # We'll store our nodes as a 1D list, so parent and child ID's are recorded as their indices in the list 
    sliceBox.data <- reactiveValues(display=list(), selected=list()) 
    rootNode <- newNode(1, 0) # Page loads with NULL first node, before input is chosen 
    sliceBox.tree <- reactiveValues(tree=list(rootNode)) 
    # Special case for loading data into first node, needs reactive parentData - not the case for children nodes 
    observeEvent(input$dataset, { 
    slice <- reactive({ 
     sliceData(d.Preview(), input$sliceBoxSelect1) 
    }) 
    # Creating data for the first node 
    sliceBox.data$display[[1]] <- reactive(slice()) 
    sliceBox.data$selected[[1]] = reactive({ 
     selectedRows <- input[[paste0("sliceBoxTable", 1, "_rows_selected")]] 
     filterData(d.Preview(), sliceBox.data$display[[1]](), selectedRows, input[[paste0("sliceBoxSelect",1)]]) 
    }) 

    }) 

    # Keep a total count of all the button presses (also used loosely as the number of tables created) 
    v <- reactiveValues(counter = 1L) 
    # Every time v$counter is increased, create new handler for the new button at id=v$counter 
    observeEvent(v$counter, { 
    parentId <- v$counter 
    buttonID <- paste0("sliceBoxButton", parentId) 

    # Button handlers to create new sliceBoxes 
    observeEvent(input[[buttonID]], { 
     v$counter <- v$counter + 1L 
     childId <- v$counter 
     # Note that because the ObserveEvents are run separately on different triggers, (childId != parentId+1) 

     # Create new child 
     sliceBox.tree$tree[[childId]] <- newNode(childId, parentId, choices = names(d.Preview())) # added choices 

     # Append new childId to parent's list of children 
     numChildren <- length(sliceBox.tree$tree[[parentId]]$children) 
     sliceBox.tree$tree[[parentId]]$children[numChildren+1] <- childId 
    }) 
    }) 

} 

ui <- fluidPage(theme = "bootstrap.css", 
       # Main display body 
       fluidRow(style="padding:5px", 
         selectInput("dataset", "Choose a dataset:", choices = c("mtcars", "iris", "esoph"), selected=NULL), 
         tags$div(uiOutput("allSliceBoxes"), style="padding:20px") 
       ) 
) 

shinyApp(ui = ui, server = server)