在服務器

Question

無法識別動態創建selectInputs我創建了一個簡單的項目中，我生成從在一個模塊（選擇器）的列表選擇輸入返回輸入列表。我有另一個模塊（查看器），它接受從選擇器模塊返回的輸入，並生成與Count selectInput值相對應的多個textOutput，其文本對應於Colors selectInput值。 問題是生成的輸入未被識別，因此未被輸入列表挑選返回。我可以讓他們識別的唯一方法是，如果我對我不想做的selectInputs進行硬編碼（我已經將它們添加到了selectorUI中作爲參考的註釋）。

ui.R

library(shiny) 
HOME_DIR<-getwd() 
source(file.path(HOME_DIR,'subUI.R'),local=TRUE) 
shinyUI(fluidPage(
    titlePanel("Sample App"), 
    sidebarLayout(
     sidebarPanel(
     selectorUI("selectorModl") 
    ), 
    mainPanel(
     viewerUI("viewerModl") 
    ) 
))) 

server.R

library(shiny) 
HOME_DIR<-getwd() 
source(file.path(HOME_DIR,'subUI.R'),local=TRUE) 
shinyServer(function(input, output) { 
    selection <- list("count" = c(1,2,3,4,5), "colors" = c("blue", "green","red")) 
    inputValues<-reactive(callModule(selector,"selectorModl", selection)) 
    observeEvent(inputValues(),{ 
     if(length(inputValues())) 
      callModule(viewer, "viewerModl", inputValues()) 
    }) 
}) 

subUI.R

#----------selector subUI 
selectorUI<-function(id){ 
    ns <- NS(id) 
    tagList(
     htmlOutput(ns("selectorPane")) 
     # selectInput(ns("count"), label = "count", choices = "", multiple = F) 
     # ,selectInput(ns("colors"), label = "colors",choices = "", multiple = F) 

    ) 
} 

selector<-function(input, output, session,selection){ 
    output$selectorPane <- renderUI({ 
     lapply(1:length(selection), function(selIdx){ 
      selName <- names(selection)[selIdx] 
      selChoices<-selection[[selName]] 
      selectInput(inputId = selName, label = selName, choices = selChoices, multiple = F) 
     }) 
    }) 
    observe({ 
     print(names(input)) 
     if(!is.null(input[["count"]])){ 
      if(input[["count"]]==""){ 
       lapply(1:length(selection), function(selIdx){ 
        selName <- names(selection)[selIdx] 
        selChoices<-selection[[selName]] 
        updateSelectInput(session, inputId = selName, choices = selChoices) 
       }) 
      }  
     } 
    }) 
    return(input) 
} 

#----------viewer subUI 
viewerUI<-function(id){ 
    ns <- NS(id) 
    uiOutput(ns("viewerPane")) 
} 

viewer<-function(input, output, session, inputValues){ 
    output$viewerPane <- renderUI({ 
     if(length(inputValues) > 0) 
      if(!is.null(inputValues[["count"]]) && inputValues[["count"]] != "" && !is.null(inputValues[["colors"]])) 
      lapply(1:inputValues[["count"]], function(idx){ 
       textInput(paste("text",idx, sep = "_"), label = "", value = inputValues[["colors"]]) 
      }) 
    }) 
} 

這裏是想什麼，我來實現屏幕截圖。任何幫助，將不勝感激。謝謝！

Answer 1

我包括這作爲單獨的答案，以避免混淆的代碼。

這是使用模塊和動態UI一個工作版本。請注意在模塊內使用ns <- session$ns。還要注意反應功能。我通常會命名變量rfVariableName來提醒我它是一個反應函數，而不僅僅是一個正常變量。

library(shiny) 

# selctor Module --------------- 
selectorUI <- function(id) { 

    ns <- NS(id) 

    uiOutput(ns("selectorPane")) 

} 

selector <- function(input, output, session, selection) { 

    output$selectorPane <- renderUI({ 

    ns <- session$ns 

    tagList(
     lapply(1:length(selection), function(selIdx){ 
     selName <- names(selection)[selIdx] 
     selChoices <- selection[[selName]] 
     selectInput(inputId = ns(selName), label = selName, choices = selChoices, multiple = F) 
     }) 
    ) 

    }) 

    allInputs <- reactive({ 
    l <- lapply(1:length(selection), function(getid) { 
     selName <- names(selection)[getid] 
     input[[selName]] 
    }) 
    names(l) <- names(selection) 
    l 
    }) 

    return(allInputs) 

} 

# Viewer Module --------------- 
viewerUI <- function(id) { 
    ns <- NS(id) 

    uiOutput(ns("viewerPane")) 

} 

viewer <- function(input, output, session, inputValues) { 

    output$viewerPane <- renderUI({ 

    ns <- session$ns 

    if (length(inputValues()) > 0) { 
     if (!is.null(inputValues()[["count"]])) { 
     if (inputValues()[["count"]] > 0) { 
      tagList(
      lapply(1:inputValues()[["count"]], function(idx){ 
       textInput(ns(paste("text",idx, sep = "_")), label = "", value = inputValues()[["colors"]]) 
      }) 
     ) 
     } 
     } 
    } 

    }) 

} 



# Main UI -------------- 
ui <- shinyUI(fluidPage(
    titlePanel("Sample App"), 
    sidebarLayout(
    sidebarPanel(
     selectorUI("selectorModl") 
    ), 
    mainPanel(
     viewerUI("viewerModl") 
    ) 
))) 


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

    selection <- list("count" = c(1,2,3,4,5), "colors" = c("blue", "green","red")) 

    inputValues <- callModule(selector,"selectorModl", selection = selection) 

    observeEvent(inputValues(),{ 

    if (length(inputValues()) > 0) { 
     callModule(viewer, "viewerModl", inputValues = inputValues) 
    } 

    }) 

} 

shiny::shinyApp(ui, server) 

Answer 2

有幾個方法中一個閃亮的應用程序創建動態UI。您已使用renderUI。您也可以嘗試insertUI或conditionalPanel。 conditionalPanel是實現你想要的最簡單的方式（我認爲）。這意味着您不必擔心重新創建投入，與其相關的觀察員並保持其當前選定的值。 conditionalPanel保持邏輯客戶端，這意味着它有一個響亮的響應，不會淡入/淡出。示例（不包含模塊）：

library(shiny) 

choices_count <- c(1:10) 

ui_conditional <- function(count_i) { 
    conditionalPanel(condition = paste0("input.select_count >= ", count_i), 
        textOutput(paste0("text_", count_i)) 
    ) 
} 

ui <- shinyUI(fluidPage(

    titlePanel("Sample app"), 

    sidebarLayout(

    sidebarPanel(
     selectInput("select_count", "Count", choices = choices_count), 
     selectInput("select_colour", "Colour", choices = c("blue", "green", "red")) 
    ), 

    mainPanel(
     lapply(choices_count, ui_conditional) 
    ) 
) 

)) 

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

    observeEvent(input$select_colour, { 
    for (i in choices_count) { 
     output[[paste0("text_",i)]] <- renderText(input$select_colour) 
    } 
    }) 

} 

shinyApp(ui, server) 

Answer 3

如果我理解正確，那麼您的問題是要了解如何在服務器端生成動態UI組件。

我試圖實現類似於你有什麼作爲UI例如東西，使用動態組件。

library(shiny) 

#------------------------------------------------------------------------------ 
# 
# Any general purpose assignment, available for any session, should be done here or on a sourced file 
countLb <- c(1,2,3,4,5) 
colorLb <- c("blue", "green","red") 

# dynamic elements can potentially live either in a separate file, or here, or in the Server part. 
# Of course they need to be in Server if you change them dynamically! 

dynUI <- list(
    selectInput("inputID1", label = "count", choices = countLb, multiple = F) 
, selectInput("inputID2", label = "colors", choices = colorLb, multiple = F) 
) 

ui <- fluidPage(
    titlePanel("Sample App"), 
    sidebarLayout(
    sidebarPanel(
     uiOutput("selectorModl") 
    ), 
    mainPanel(
     uiOutput("viewerModl") 
    ) 
)) 

server = function(input, output,session) { 


output$selectorModl <- renderUI({ 
    dynUI 
}) 

output$viewerModl <- renderUI({ 

    if((length(input$inputID1) == 0) | (length(input$inputID2) == 0)) return() 
    isolate({ 
    toRender <- lapply(1:input$inputID1, function(i) { 
    textInput(paste("text",i, sep = "_"), label = "", value = input[["inputID2"]]) 
    }) 
    return(toRender) 
    }) # end isolate 
}) 
} 

shinyApp(ui,server) 

請讓我知道如果我接近滿足您的要求，如果您需要對此代碼進行進一步的說明。