有没有办法使用 Shiny 在 R 中制作两个侧面板和额外的测试脚本？

如何解决有没有办法使用 Shiny 在 R 中制作两个侧面板和额外的测试脚本？

有没有办法在我的 Shiny 应用程序中制作两个“复选框”？一种用于选择我想要进行的“测试”（等检查空值、检查重复值），另一种用于选择我想要为测试选择的文件中的哪些列。目标是制作一个数据质量应用程序，我可以在其中选择要进行各种数据质量检查的字段。 另外，我将如何在我的 UI 中添加额外的测试，例如检查空值？

我是 Shiny 软件包的新手，希望得到一些见解。谢谢！

以下是我的代码，目前我只有一个测试代码（检查重复值）：

library(shiny)
fp = 'C:/Users/WangE/Documents/DQA Test/'
library("readr")
library("dplyr")
library("tidyr")
library("data.table")
library("stringr")
library("RODBC")
library("openxlsx")
library("reshape")
library("readr")
library("ggplot2")
library("reshape2")
library("readxl")
library("varhandle") 
library("eeptools")
library("stringr")
options(scipen = 999)



TestData<-function(cols,data) {
 unique_checker <- cols
  duplicate_tracker <- list() 
  Other_Source_Total <- data %>% mutate_all(na_if,"")
  for(i in colnames(Other_Source_Total)){   
    if(toString(i) %in% unique_checker){   
      duplicate <- duplicated(tolower(Other_Source_Total[[i]])) | duplicated(tolower(Other_Source_Total[[i]]),fromLast = TRUE)
      Other_Source_Total$duplicate <- duplicate  
      duplicate_records <- Other_Source_Total  %>% filter(!is.na(Other_Source_Total[[i]])) %>% filter(duplicate == TRUE)
      if(NROW(duplicate_records != 0)){
        write.csv(duplicate_records,paste(fp,"Duplicate_Records_",str_remove(toString(i),'/'),".csv",sep =""))
      }
      duplicate_tracker[[i]] <- NROW(duplicate_records)
    }
  }
  Other_Source_Total = subset(Other_Source_Total,select = -c(duplicate) ) 
  return(duplicate_tracker)
 
 } 


options(shiny.maxRequestSize = 900*1024^2)

ui <- pageWithSidebar(
  headerPanel("CSV Viewer"),sidebarPanel(
    fileInput('file1','Choose File',accept=c('text/csv','text/comma-separated-values,text/plain','.csv')),tags$hr(),tags$head(),checkBoxGroupInput("inCheckBoxGroup","CheckBox group input:",c()),uIoUtput('choose_columns'),actionButton('doit','Do stuff')
  ),mainPanel(
    tableOutput('contents')
  )
)

server <- function(input,output,session) {
  dsnames <- c()
  
  data_set <- reactive({
    req(input$file1)
    inFile <- input$file1
    data_set<-read.csv(inFile$datapath,header=TRUE,sep=',')
  })
  output$contents <- renderTable({
    data_set()[1:min(length(data_set()),500),]
  })
  observe({
    req(input$file1)
    dsnames <- names(data_set())
    cb_options <- list()
    cb_options[ dsnames] <- dsnames
    updateCheckBoxGroupInput(session,"inCheckBoxGroup",label = "Check Box Group",choices = cb_options,selected = "")
  })
  
  output$choose_dataset <- renderUI({
    req(input$Go)
    testVals<-selectInput("dataset","Data set",as.list(data_sets))
  })
  
  # Check Boxes
  output$choose_columns <- renderUI({
    # If missing input,return to avoid error later in function
    if(is.null(input$dataset))
      return()
    
    # Get the data set with the appropriate name
    
    colnames <- names(contents)
    
    # Create the checkBoxes and select them all by default
    checkBoxGroupInput("columns","Choose columns",choices  = colnames,selected = colnames)
  })
  
  observeEvent(input$doit,{
    value <- TestData(input$inCheckBoxGroup,data_set())
    print(value)
  })
  
  
}
shinyApp(ui,server)

下面是我的用户界面的图片：

image here

解决方法

我认为通常的方法是使用多选项选择框来选择要处理的列（或显示在数据表中）。请参阅此处的“无选择提示，多个”示例：https://shiny.rstudio.com/gallery/selectize-vs-select.html。

有几种方法可以解决这个问题，但我提供了一个有用的数据驱动的控件和事件示例，可能会有所帮助。在您的情况下，您将有一个选择或下拉列表来选择测试，然后在服务器代码中它检测到测试已被选择的事件并更新具有列选择的多选项选择框（使用 updateSelectInput）。在此示例中，列的选择也被检测为事件，并更新数据表的数据。还有其他方法可以在不更改其他人可能建议的数据的情况下更新客户端上的数据表。

library(shiny)
library(DT)

# global data only for example
ds <- list(faithful = datasets::faithful,iris = datasets::iris)

ui <- fluidPage(titlePanel("Select Example"),sidebarLayout(
                    sidebarPanel(
                        selectInput(
                            "sel_dataset","Options",c("faithful","iris"),multiple = FALSE,selectize = FALSE
                        ),selectInput(
                            "sel_cols",NULL,multiple = TRUE,selectize = FALSE
                        )
                    ),mainPanel(dataTableOutput("dt_data"))
                ))

server <- function(input,output,session) {
    rv <- reactiveValues(dataset = NULL,cols = NULL)
    
    observeEvent(input$sel_dataset,{
        rv$dataset <- ds[input$sel_dataset][[1]]
        rv$cols <- colnames(rv$dataset)
        updateSelectInput(session,"sel_cols",choices = rv$cols,selected = rv$cols)
    })
    
    observeEvent(input$sel_cols,{
        rv$cols <- input$sel_cols
    },ignoreInit = TRUE)
    
    table_data <- reactive({
        if (!is.null(rv$cols)) {
            rv$dataset[,rv$cols,drop = FALSE]
        } else {
            rv$dataset
        }
    })
    
    output$dt_data = DT::renderDataTable({
        table_data()
    })
}

shinyApp(ui = ui,server = server)