Question

我试图将反应性数据表的一组选定列传递给用户定义的函数。我希望能够通过pickerInput的{{1}}选择列。我没有收到错误，但是通常不会出现shinyWidgets引起的下拉菜单。我认为将pickerInput放在pickerInput中是可以的，但是由于某些原因却不可行。

我尝试使用renderUI数据集以最小的可重现示例进行此操作。

RLdata10000

UI

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)下拉列表选择一组列
将上面定义的函数pickerInput应用于所选的列集
在反应性数据表中显示输出。

任何帮助将不胜感激。

Answer 1

您需要指定uiOutput，以便应用知道在用户界面中放置所需元素的位置。两个输出元素（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

}

r闪亮-将函数应用于通过pickerInput

1 个答案: