Question

我正在构建一个允许用户上传数据文件的应用程序，然后使用标准方法分析数据。分析是依赖的上传文件后填充的一个用户输入参数上。

过程是：

用户上传.csv文件。
uiOutput（）中，将唯一级别填充到上传的数据。
用户在uiOutput（）中选择一个选项
用户单击“运行分析”。
表中显示了结果。
用户可以将分析结果表下载为.csv。

分析的第4步应通过第3步的输入来过滤数据。

我在服务器功能中使用了renderUI，以便根据用户上传的文件变量中的唯一名称（级别）进行选择。根据先前关于SO的答案，我使用uiOutput而不是ui中的selectInput（）。这允许基于上载的数据填充输入。但这实际上是renderUI的输出。我希望使用此选项来过滤数据，但是我不知道如何指定此过滤条件。

感兴趣的代码块是根据用户输入的####运行分析####

library(shiny)
library(shinythemes)
library(shinyWidgets)
library(dplyr)
library(DT)
library(shinyjs)
library(dplyr)
library(tidyr)
library(stringr)


data_example <- structure( # save as .csv and upload to app
    list(
        site = c("A", "A", "A"),
        analyte = c("x", "y",
                    "z"),
        QA = c(4L, 6L, 3L),
        A1 = c(2L, 6L, 5L),
        A2 = c(1L, 8L,
               4L),
        A3 = c(8L, 32L, 12L)
    ),
    class = "data.frame",
    row.names = c(NA,-3L)
)

#### Define UI for data upload app ####
ui <- fluidPage(theme = shinytheme("flatly"),
                # set the theme aesthetic

                # App title ----
                tags$h3("demo"),
                # Sidebar layout with input and output definitions ----
                sidebarLayout(
                    sidebarPanel(
                        width = 3,
                        #### conditional panel for surface water QA ######
                        conditionalPanel(
                            condition = "input.conditionedPanels == 1",
                            tags$h4("Load data"),
                            tags$hr(style = "border-color: black;"),
                            fileInput(
                                "file1",
                                "Import file",
                                multiple = FALSE,
                                accept = c("text/csv",
                                           "text/comma-separated-values,text/plain",
                                           ".csv")
                            ),

                            checkboxInput("header", "The dataset has column names", TRUE),
                            radioButtons(
                                "sep",
                                "How are the columns seperated?*",
                                choices = c(
                                    Comma = ",",
                                    Semicolon = ";",
                                    Tab = "\t"
                                ),
                                selected = ",",
                                inline = TRUE
                            ),
                            tags$hr(style = "border-color: black;"),
                            tags$h4("Analysis options"),
                            checkboxInput("show_sw", label = "Show  data", value = TRUE),
                            uiOutput("select_qa_site"),

                            actionButton("run_qa", "Run analysis"),
                            downloadButton("download_qa_sw_table", "Download results")
                        )

                    ),

                    #### Main panel (tabs) for displaying outputs ####
                    mainPanel(
                        useShinyjs(),
                        tabsetPanel(
                            type = "tabs",
                            tabPanel(
                                "QA",
                                br(),
                                tags$h4("Raw data view"),
                                tags$hr(style = "border-color: black;"),
                                dataTableOutput("sw_table"),
                                br(),
                                tags$h4("Analysis view"),
                                tags$hr(style = "border-color: black;"),
                                dataTableOutput("sw_qa_results_table"),
                                value = 1
                            ),
                            id = "conditionedPanels"
                        )

                    )

                ))

server <- function(input, output) {
    #### data input for surface water ####
    data_input <- reactive({
        read.csv(input$file1$datapath,
                 header = input$header,
                 sep = input$sep)
    })

    #### sample site names to choose from and run QA analysis ####
    sw_site_names <- reactive({
        req(input$file1)
        names_sw_data <- colnames(data_input())
        names_sw_data[!(colnames(data_input()) %in% c("site",
                                                      "analyte",
                                                      "QA"))]
    })

    output$select_qa_site <- renderUI({
        # Selecting site names based on variable in uploaded data
        selectInput(
            "Select_site",
            label = h4("Select QA sample site"),
            choices = sw_site_names(),
            selected = NULL
        )
    })


    #### produce data table for raw data inspection  ####
    output$sw_table <- renderDataTable({
        req(input$file1)
        datatable(
            data_input(),
            rownames = FALSE,
            options = list(autoWidth = TRUE, scrollX = TRUE)
        )
    })


    #### show/hide raw data table ####
    observeEvent(input$show_sw, {
        if (input$show_sw)
            show("sw_table")
        else
            hide("sw_table")
    })

    #### run analysis based on user input ####
    qa_table <- eventReactive(input$run_qa, {
        data_input() %>%
            gather(sample_location,
                   value,-c(site, analyte, QA)) %>%
            mutate(
                absolute_diff = abs(value - QA),
                value_mean = (value + QA) / 2,
                RPD = round((absolute_diff / value) * 100, 2)
            ) %>%
            filter() # I would like to filter this data based on input from user #
    })

    #### render results of QA analysis to a table for inspection before downloading ####
    output$sw_qa_results_table <- renderDataTable({
        req(input$file1)
        datatable(
            qa_table(),
            rownames = FALSE,
            options = list(autoWidth = FALSE, scrollX = TRUE)
        )
    })

}

##### Create Shiny app ####
shinyApp(ui, server)

我也可能只是过度设计了代码，所以我很高兴获得建议相同的结果，但是使用不同的方法。

我已经搜索了关于SO的解决方案，但不认为这是重复的问题，但是如果解决方案已经存在，我很高兴得到解决。

感谢您的帮助。

Answer 1

我相信您想按sample_location进行过滤？

您可以通过拥有filter(sample_location == input$Select_site)

因此您的qa_table将是：

  #### run analysis based on user input ####
  qa_table <- eventReactive(input$run_qa, {
    data_input() %>%
      gather(sample_location,
             value,-c(site, analyte, QA)) %>%
      mutate(
        absolute_diff = abs(value - QA),
        value_mean = (value + QA) / 2,
        RPD = round((absolute_diff / value) * 100, 2)
      ) %>%
      filter(sample_location == input$Select_site) 
  })

根据用户上传数据后选择的用户输入过滤数据帧

1 个答案: