闪亮的反应值中的变异和分组问题

Question

我的闪亮应用将按以下方式使用：

上传 csv（选项卡 1）
select 感兴趣的变量（选项卡 2）
按下按钮进行操作（选项卡 2）

操作是按组（trial_id）统计唯一观察值（因子A）的数量，以估计特定试验的自由度（对stats感兴趣的人会明白我的意思）。但是，我无法使用反应值（csv 文件的 selected 变量）进行分组。我已经尝试了很多东西。 rlang 等。即使打印输出，group_by 函数也无法正确获得正确的分组。任何帮助将不胜感激。

# Packages library =================================================

# load or install packages
library(shiny)
library(shinydashboard)
library(tidyverse)
library(data.table)
library(rlang)


# Tab Content =========================================================================

# Upload file tab ----------------------------------------------

upload_tab <-     tabItem(tabName = "FileUpload",
                          titlePanel("Uploading Files"),
                          sidebarPanel(
                            fileInput('file1', 'Choose file to upload',
                                      accept = c('text/csv',
                                                 'text/comma-separated-values',
                                                 'text/tab-separated-values',
                                                 'text/plain','.csv','.tsv')),
                            checkboxInput("header", "Header", TRUE),
                            radioButtons("sep", "Separator",
                                         choices = c(Comma = ",",
                                                     Semicolon = ";",
                                                     Tab = "\t"),
                                         selected = ","),
                            radioButtons("quote", "Quote",
                                         choices = c(None = "",
                                                     "Double Quote" = '"',
                                                     "Single Quote" = "'"),
                                         selected = '"')),
                          mainPanel(
                            DT::dataTableOutput('contents')
                          )
)


# Estimator tab --------------------------------------------------------------------
estimator_tab <-  tabItem(tabName = "Estimator",
                          fluidPage(
                            fluidRow(
                              box(title = "Design", width = 6, solidHeader = T, status = "primary",
                                  fluidRow(
                                    column(8,
                                           sliderInput('alpha',"Significance level ?? ",0.05, min = 0.01, max = 0.10))),
                                  br(),
                                  br(),
                                  actionButton("go_button", "Estimate"),
                                  br(),
                                  br(),
                                  br(),
                                  uiOutput("downloadData")),
                              box(title = "Column ID", width = 6, solidHeader = T, status = "primary",
                                  column(8, selectInput("trial_id", "Trial ID", NULL),
                                         selectInput("factor_A", "Factor A", NULL),
                                         selectInput("replicates", "Replicates", NULL)))),
                            br(),
                            mainPanel(
                              DT::dataTableOutput('contents1')
                            )
                          )
)



# SideBar content =========================================================================

sideBar_content <- dashboardSidebar(
  sidebarMenu(
    menuItem("Upload File", tabName = "FileUpload"),
    menuItem("Estimator", tabName = "Estimator")
  )
)

# BODY content ------------------------------------------------------------------------------

body_content <- dashboardBody(
  tabItems(
    upload_tab,
    estimator_tab
  )
)

# UI =========================================================================

ui <-  dashboardPage(
  dashboardHeader(title = "Test"),
  ## Sidebar content
  sideBar_content,
  ## Body content
  body_content,
  ## Aesthetic
  skin = "blue"
)

# Server =========================================================================
server <- function(input, output,session) {
  
  
  data<-reactive({
    if(is.null(input$file1))
      return()
    inFile <- input$file1
    df <- read.csv(inFile$datapath,
                   header = input$header,
                   sep = input$sep,
                   quote = input$quote)
  }) 
  
  rv <- reactiveValues(data = data,
                       trial_id = NULL,
                       replicates = NULL)
  
  
  output$contents <- DT::renderDataTable({
    DT::datatable(data(),
                  options = list(
                    "pageLength" = 40))
  })
  
  # observe variable names from csv file
  observe({
    value <- names(data())
    updateSelectInput(session,"trial_id", choices = value)
    updateSelectInput(session,"replicates", choices =value)
    updateSelectInput(session,"factor_A", choices = value)
  })
  
  
  observeEvent(input$trial_id, {
    rv$trial_id <- data()[,input$trial_id]
  })
  observeEvent(input$replicates, {
    rv$replicates <- data()[,input$replicates]
  })
  observeEvent(input$factor_A, {
    rv$factor_A <- data()[,input$factor_A]
  })

  
  data_filtered<- reactive({
    dt<- data() %>% group_by(rv$trial_id) %>% dplyr::mutate(n_factor_A = length(unique(rv$factor_A)))
  })
  
  addData <- eventReactive(input$go_button, {
    return(data_filtered() %>% group_by(rv$trial_id) %>% dplyr::mutate(df_error = (n_factor_A-1)*(replicates-1)))}
  
  output$contents1 <- DT::renderDataTable({
      DT::datatable(addData(),
                    options = list("pageLength" = 40))
  })
 
  
}

# Run shiny app ---------------------------------------------------------------------------

shinyApp(ui, server)

数据

file<-c(structure(list(trial_id = c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 4L, 4L, 4L, 4L, 4L, 4L
), factor_A = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 13L, 14L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 6L), replicates = c(3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 5L, 5L, 5L, 
5L, 5L, 4L, 4L, 4L, 4L, 4L, 4L), means = c(57.5, 22.5, 17.5, 
25, 5, 2, 3, 2, 12.5, 25, 3, 2.8, 1, 0.5, 64.1, 80.7, 83, 84.4, 
83.7, 25, 20, 25, 26, 27, 28), letters = c("a", "b", "bc", "b", 
"de", "e", "e", "e", "cd", "d", "e", "e", "e", "e", "a", "b", 
"b", "b", "b", "a", "b", "a", "a", "a", "a")), class = "data.frame", row.names = c(NA, 
-25L)))```

Answer 1

也许您正在寻找这个

  data_filtered<- reactive({
      data() %>% dplyr::group_by(.data[[input$trial_id]]) %>% dplyr::mutate(n_factor_A = length(unique(.data[[input$factor_A]])))
  })
  
  addData <- eventReactive(input$go_button, {
    return(data_filtered() %>% dplyr::summarise(df_error = (n_factor_A-1)*(replicates-1)) %>% distinct())
  })

闪亮的反应值中的变异和分组问题

trouble with mutate and group by in reactive values in shiny

group-by

shiny

dplyr

reactive