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()下显示。也许我可以在每种情况下都使用if，但是问题是我的真实数据集可能更大，并且每次都有不同的列名，因此我正在寻找一种方法，可以立即将pickerInput()选择的名称与创建将包含列值的相对pickerInput()。例如，如果某人选择所有4个列名4 pickerInput()，则应使用相对列名作为标签来创建。

我的方法是insertUI方法，但是我必须找到一种方法来创建具有不同选择和标记的小部件，并在取消选择第一个pickerInput()的相对值时也将其删除。

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)
            )

            
        ),
        
        mainPanel(
        )
    )
)

# server()
server <- function(input, output) {
    
    observeEvent(input$p1, {
        insertUI(
            selector = "#p1",
            where = "afterEnd",
            ui = pickerInput(
                inputId = #The colname of selected column
                    ,
                label = #The colname of selected column
                    ,
                choices = #all rows of selected column
                    ,
                multiple = TRUE,
                options = list(`actions-box` = TRUE)
            )
        )
    })

    
    
    
}

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

Answer 1

您可以将AFTER=`echo $var | sed 's/\r//g'`与lapply一起使用，而不是renderUI

insertUI

Answer 2

我真的不喜欢使用lapply来创建闪亮的输入元素，因为当您添加元素时，已经存在的（选定的）输入的输入UI会被覆盖，因此所有内容都设置为这些输入的默认值和先前选择的值会丢失。

您可以将insertUI与removeUI和一个变量配对，以跟踪先前选择的列。然后，您可以动态添加/删除UI元素，并使其他输入保持不变。

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)

我将插入的pickerInputs包裹在div中，因此删除它们更容易。另外，您需要为观察者设置ignoreNULL = FALSE，以便在取消选择所有元素时也将触发它。

Answer 3

一种可能的解决方案是生成pickerInput列表并使用tagList中的renderUI进行渲染：

# Data
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)


# App
library(shiny)
library(shinyWidgets)
library(DT)
# ui object
ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      uiOutput("pickers")
      
    ),
    
    mainPanel(
    )
  )
)

# server()
server <- function(input, output) {
  pickers <- colnames(dt)
  output$pickers <- renderUI({
    l <- list()
    for (i in 1:length(pickers)) {
       l[[i]] <- pickerInput(pickers[i],pickers[i],dt[[pickers[i]]])
    }
    tagList(l)
   })

}

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

使用insertUI方法创建不同的闪亮小部件

3 个答案: