Question

下面有一个闪亮的应用程序，用户可以在其中从数据框中选择一个或多个列名。

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)

然后，他所做的每个选择都将在相对位置pickerInput()下显示。问题是我想为特定的列设置一个不同的窗口小部件。假设我想将数字值设置为sliderInput()。我在同一个应用程序下有2个版本。因此，如果有任何解决方案适用于其中的一种，就可以了。

app1

library(shiny)
library(shinyWidgets)
library(DT)
# ui object
ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "p1",
        label = "Select Column headers",
        choices = colnames( dt),
        multiple = TRUE,
        options = list(`actions-box` = TRUE)
      ),
#Add the output for new pickers
      uiOutput("pickers")
    ),
    
    mainPanel(
    )
  )
)

# server()
server <- function(input, output) {
  
  observeEvent(input$p1, {
#Create the new pickers 
    output$pickers<-renderUI({
      
      div(lapply(input$p1, function(x){
        pickerInput(
          inputId = x#The colname of selected column
            ,
          label = x #The colname of selected column
            ,
          choices = dt[,x]#all rows of selected column
            ,
          multiple = TRUE,
          options = list(`actions-box` = TRUE)
        )
      }))
    })
  })
}

# shinyApp()
shinyApp(ui = ui, server = server)

app2

library(shiny)
library(shinyWidgets)
library(DT)

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)

# ui object
ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "p1",
        label = "Select Column headers",
        choices = colnames( dt),
        multiple = TRUE,
        options = list(`actions-box` = TRUE)
      ),
      tags$div(id = "add_ui_here")
      
      
    ),
    
    mainPanel(
    )
  )
)

# server()
server <- function(input, output) {
  
  # store currently selected columns
  selected_columns <- c()
  
  observeEvent(input$p1, {
    
    # determine pickerInputs to remove
    input_remove <- !selected_columns %in% input$p1
    input_remove <- selected_columns[input_remove]
    
    # remove inputs
    if (!is.null(input_remove) && length(input_remove) > 0) {
      for (input_element in input_remove) {
        removeUI(selector = paste0("#", input_element, "_remove_id"))
      }
    }
    
    # determine pickerInputs to add
    input_add <- !input$p1 %in% selected_columns
    input_add <- input$p1[input_add]
    
    # add inputs
    if (length(input_add) > 0) {
      for (input_element in input_add) {
        insertUI(
          selector = "#add_ui_here",
          where = "afterEnd",
          ui = tags$div(id = paste0(input_element, "_remove_id"),
                        pickerInput(
                          inputId = input_element
                          ,
                          label = input_element
                          ,
                          choices = dt[, input_element]
                          ,
                          multiple = TRUE,
                          options = list(`actions-box` = TRUE)
                        ))
        )
      }
    }
    
    # update the currently stored column variable
    selected_columns <<- input$p1
  },
  ignoreNULL = FALSE)
  
  
  
  
}

# shinyApp()
shinyApp(ui = ui, server = server)

Answer 1

检查所选变量是数字还是字符，然后分配适当的小部件。试试这个代码。

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)


# ui object
ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "p1",
        label = "Select Column headers",
        choices = colnames( dt),
        multiple = TRUE,
        options = list(`actions-box` = TRUE)
      ),
      #Add the output for new pickers
      uiOutput("pickers")
    ),
    
    mainPanel(
    )
  )
)

# server()
server <- function(input, output) {
  
  observeEvent(input$p1, {
    #Create the new pickers 
    output$pickers<-renderUI({
      div(lapply(input$p1, function(x){
        if (is.numeric(dt[[x]])) {
          sliderInput(inputId=x, label=x, min=min(dt[x]), max=max(dt[[x]]), value=min(dt[[x]]))
        }
        else if (is.character(dt[[x]])) {
          pickerInput(
            inputId = x#The colname of selected column
            ,
            label = x #The colname of selected column
            ,
            choices = dt[,x]#all rows of selected column
            ,
            multiple = TRUE,
            options = list(`actions-box` = TRUE)
          )
        }
        
      }))
    })
  })
}

# shinyApp()
shinyApp(ui = ui, server = server)

使用insertUI创建其他种类的闪亮小部件

1 个答案: