Question

我正在尝试创建一个界面，允许用户选择要关注的列数，然后在每列中选择一个唯一值。

我现在的代码与列名和列名不匹配。当我只选择1列时，它确实有效。但是，当有> 1列时，它不起作用。 “选择属性值”始终采用第一个“选择属性”。我希望它们兼容。

 library(shiny)


ui<-shinyUI(fluidPage(fluidRow(column(width = 4, 

    numericInput("assets", label = "Choose How Many Attributes to Produce in the Map:", value="1"),
    uiOutput("variants"),
    uiOutput("variants2")

    )


)))

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

  df<-read.csv("diff_block.csv", stringsAsFactors=FALSE, colClasses="character")
  df$X<-NULL


  output$variants <- renderUI({
    numAssets <- as.integer(input$assets)  
    lapply(1:(numAssets), function(i) {
          list(selectInput ("choose_columns", 
                        "Choose Attribute", 
                        sort(unique(names(df)), decreasing = FALSE),
                        selected=""))

    })
  })

    output$variants2 <- renderUI({
      numAssets <- as.integer(input$assets)  



      lapply(1:(numAssets), function(j) {

      selectInput ("choose_columns2", 
                 "Choose Attribute Value", 
                 sort(unique(df[,input$choose_columns]), decreasing = FALSE),
                 selected="")
      })
    })
      })

shinyApp(ui, server)

Answer 1

您创建的sliderInputs始终具有相同的ID (selectInput ("choose_columns", ...))。诀窍是使用paste0函数创建具有不同id的窗口小部件，然后使用[[运算符访问它们的值。

library(shiny)


ui<-shinyUI(fluidPage(fluidRow(column(width = 4, 

                                      numericInput("assets", label = "Choose How Many Attributes to Produce in the Map:", value="1"),
                                      uiOutput("variants"),
                                      uiOutput("variants2")

)


)))

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

  #df<-read.csv("diff_block.csv", stringsAsFactors=FALSE, colClasses="character")
  #df$X<-NULL
  df <- iris


  # output$variants <- renderUI({
  #   numAssets <- as.integer(input$assets)
  #   lapply(1:(numAssets), function(i) {
  #     list(selectInput ("choose_columns",
  #                       "Choose Attribute",
  #                       sort(unique(names(df)), decreasing = FALSE),
  #                       selected=""))
  # 
  #   })
  # })

  output$variants <- renderUI({
    numAssets <- as.integer(input$assets)
    lapply(1:(numAssets), function(i) {
      list(selectInput (paste0("choose_columns", i),
                        "Choose Attribute",
                        sort(unique(names(df)), decreasing = FALSE),
                        selected=""))

    })
  })

  output$variants2 <- renderUI({
    numAssets <- as.integer(input$assets)  



  #   lapply(1:(numAssets), function(j) {
  #     
  #     selectInput ("choose_columns2", 
  #                  "Choose Attribute Value", 
  #                  sort(unique(df[,input$choose_columns]), decreasing = FALSE),
  #                  selected="")
  #   })
  # })

    lapply(1:(numAssets), function(j) {

      var <- input[[paste0("choose_columns", j)]]

      selectInput (paste0("choose_attribute", j), 
                   paste0("Choose Attribute Value of ", var),
                   sort(unique(df[ ,var]), decreasing = FALSE),
                   selected="")
    })
  })
})

shinyApp(ui, server)

在R闪亮中有两个动态selectInput

1 个答案: