时间戳

首页 > 解决方案 > 有没有一种方法可以让我使用 Shiny 在 R 中制作两个侧面板和额外的测试脚本？

r - 有没有一种方法可以让我使用 Shiny 在 R 中制作两个侧面板和额外的测试脚本？

问题描述

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

下面是我的 UI 的图片：

图片在这里

标签： rshiny

解决方案

我认为通常的方法是使用多选项选择框来选择要处理的列（或显示在数据表中）。请参阅此处的“无选择提示，多个”示例：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",
                            "Options",
                            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)

推荐阅读