r shiny - 将函数应用于通过 pickerInput 选择的列

Question

我正在尝试将反应数据表的一组选定列传递给用户定义的函数。我希望能够通过pickerInput 从shinyWidgets 中选择列。我没有收到错误，但通常来自pickerInput 的下拉菜单没有出现。我认为将pickerInput 放在renderUI 中会起作用，但由于某种原因它不是。

我已经尝试通过使用RLdata10000 数据集的最小可重复示例来做到这一点。

library(shiny)
library(RecordLinkage)
data("RLdata10000")
library(shinyWidgets)


removeSPE <- function(x) gsub("[[:punct:]]", "", x)

cleanup <- function(x){
  x <- as.character(x) # convert to character
  x <- tolower(x) # make all lowercase
  x <- sapply(x, removeSPE) # remove special characters
  x <- trimws(x, "both") # since stopwords have been removed, there is extra white space left, this removes it
  x <- gsub("(?<=\\b\\w)\\s(?=\\w\\b)", "", x, perl = TRUE) # removes whitespace btwn two single chars
  return(x)
}

用户界面

##### APP BEGINS HERE WITH UI #####

ui <- fluidPage(
  navbarPage("Record Linkage",
         tabPanel("Load"
                  , dataTableOutput("records")
         ),
         tabPanel("Weights Method"
                  ,plotOutput("weightplot")
                  ,sliderInput("lowerthreshold", "Weight Lower threshold:",
                               min = 0.0, max = 1.0,
                               value =0.2)
                  ,sliderInput("upperthreshold", "Weight Upper threshold:",
                               min = 0.0, max = 1.0,
                               value =0.5)

                  ,dataTableOutput("weights")
         )
  )
)
options(shiny.maxRequestSize = 100*1024^2)

服务器

server <- function(input, output) {

  data <- reactiveValues(file1 = RLdata10000)
  output$records <- renderUI({
    pickerInput(
  inputId = "pick_col",
  label = "select columns to clean:",
  choices = colnames(data$file1),
  selected = colnames(data$file1),
  options = list(`actions-box` = TRUE,
                 `selected-text-format` = paste0("count > ", length(colnames(data$file1)) - 1),
                 `count-selected-text` = "Alle",
                 liveSearch = TRUE,
                 liveSearchPlaceholder = TRUE),   # build buttons for collective selection
  multiple = TRUE)

  })

  output$records <- renderDataTable({
RLdata10000 <-  cbind((lapply(RLdata10000[, 1:4], cleanup)), RLdata10000[5:7])
  })


  output$weights <- renderDataTable({
rec.pairs <- compare.dedup(RLdata10000
                           ,blockfld = list(1, 5:7)
                           ,strcmp =   c(2,3,4)
                           ,strcmpfun = levenshteinSim)
pairs.weights <- emWeights(rec.pairs)

pairs.classify <- emClassify(pairs.weights, threshold.upper = input$upperthreshold, threshold.lower = input$lowerthreshold)
final.results <- pairs.classify$pairs
final.results$weight <- pairs.classify$Wdata
final.results$links <- pairs.classify$prediction

    final.results

      })

  output$weightplot <- renderPlot({
rec.pairs <- compare.dedup(RLdata10000
                           ,blockfld = list(1, 5:7)
                           ,strcmp =   c(2,3,4)
                           ,strcmpfun = levenshteinSim)
pairs.weights <- epiWeights(rec.pairs)

    hist(pairs.weights$Wdata)

  })
}

shinyApp(ui, server)

我希望能够做到以下几点：

1. 通过pickerInput下拉选择一组列
2. 将上面定义的函数cleanup 应用于所选列的集合
3. 在反应式数据表中显示输出。

任何帮助将不胜感激。

Answer 1

您需要指定 uiOutput 以便应用知道在 UI 中的哪个位置放置您要求的元素。两个输出元素（renderUI 和dataTableOutput）的名称也相同，这会导致问题。将您的 ui 和服务器定义的相关部分替换为以下内容以显示 pickerInput。请注意，这并不涉及将函数应用于您选择的列，因此这只是部分答案。

ui <- fluidPage(
  navbarPage("Record Linkage",
             tabPanel("Load"
                      , uiOutput("colselect")
                      , dataTableOutput("records")
             ),
             tabPanel(
             # ... code omitted here
             )
  )
)

server <- function(input, output) {

  data <- reactiveValues(file1 = RLdata10000)
  output$colselect <- renderUI({
    pickerInput(
      inputId = "pick_col",
      label = "select columns to clean:",
      choices = colnames(data$file1),
      selected = colnames(data$file1),
      options = list(`actions-box` = TRUE,
                     `selected-text-format` = paste0("count > ", length(colnames(data$file1)) - 1),
                     `count-selected-text` = "Alle",
                     liveSearch = TRUE,
                     liveSearchPlaceholder = TRUE),   # build buttons for collective selection
      multiple = TRUE)

  })

  output$records <- renderDataTable({
    RLdata10000 <-  cbind((lapply(RLdata10000[, 1:4], cleanup)), RLdata10000[5:7])
  })

  # ... code omitted here

}