如何使用 Shiny 实现基本统计？ tapply 中的错误：参数必须具有相同的长度”答案

【问题标题】：How to achieve Basic Stats with Shiny? Error in tapply: arguments must have same length"如何使用 Shiny 实现基本统计？ tapply 中的错误：参数必须具有相同的长度”
【发布时间】：2019-03-01 14:52:44
【问题描述】：

我正在开发一个闪亮的应用程序，让实验者能够快速可视化他们的数据并与之交互。此时，Shiny 应用程序被编程为做三件事：

打印标题信息。上传的文件（成功）
打印上传文件的摘要（成功）
打印所选标识符的基本统计信息（不成功）（我修改了以下代码，并将更新后的代码粘贴在旧版本下面。

在 Shiny 应用程序中，我能够上传并从上传的文件中选择列名，但我没有得到我正在寻找的基本统计输出。作为参考，这是我称为“bs()”的向量。

当我运行应用程序时，甚至在上传测试文件之前，我都会收到以下错误消息：

Error in tapply: arguments must have same length.

当我执行独立于 Shiny 的基本统计信息时，它可以工作，我的输出表如下所示：

trt factor1  factor2  x.mean     x.sd       x.length    x.se
 0      NC      DR   36.00000   1.322876        9     0.4409586
 0      NC      ST   36.42857   2.760262        7     1.0432811
 0   t186673    DR   35.55556   2.068279        9     0.6894263
 0   t186673    SD   39.44444   2.962731        9     0.9875772

自从这篇原始帖子以来，我已经修改了“bs”，现在出现了一个新错误： “错误：选择了未定义的列”。我没有删除原来提交的代码，只是在最后复制粘贴了更新的版本，并且对更新进行了注释。

以下是我用来测试 Shiny App 的一些数据：

data <- structure(list(Strain = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 
4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("NC", "t186673", 
"t186674", "t186675"), class = "factor"), N_level = c(0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 
56L, 56L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 56L, 56L, 56L, 
56L, 56L, 56L, 56L, 56L, 56L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
0L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 0L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 
56L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 56L, 56L, 56L, 56L, 
56L, 56L, 56L, 56L, 56L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
56L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 0L, 0L, 0L, 0L, 
0L, 0L, 0L, 0L, 0L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 56L, 
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 56L, 56L, 56L, 56L, 56L, 
56L, 56L, 56L, 56L), inoc_met = structure(c(2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("DR", 
"ST"), class = "factor"), phenotype1 = c(40L, 36L, 36L, 39L, 
36L, 35L, 34L, 37L, 36L, 44L, 40L, 42L, 44L, 43L, 43L, 46L, 47L, 
44L, 35L, 42L, 37L, 38L, 37L, 38L, 38L, 36L, 38L, 42L, 35L, 45L, 
46L, 48L, 47L, 45L, 43L, 44L, 40L, NA, 37L, 39L, 40L, 38L, 37L, 
38L, 39L, 40L, 43L, 50L, 40L, 41L, 40L, 44L, 50L, 46L, 35L, NA, 
34L, 36L, 42L, 37L, 37L, 34L, NA, 38L, 42L, 42L, 28L, 32L, 33L, 
43L, 44L, 44L, 36L, 37L, 38L, 38L, 33L, 37L, 34L, 33L, 34L, 35L, 
42L, 38L, 42L, 40L, 44L, 45L, 42L, 41L, 43L, 41L, 41L, 42L, 47L, 
46L, 43L, 42L, 40L, 45L, 45L, 42L, 44L, 43L, 45L, 42L, 39L, 42L, 
35L, 37L, 34L, 38L, 43L, 45L, 33L, 36L, 35L, 46L, 44L, 42L, 42L, 
40L, 48L, 40L, 50L, 45L, 35L, 37L, 34L, 37L, 35L, 38L, 36L, 37L, 
35L, 40L, 39L, 39L, 35L, 32L, 33L, NA, 46L, 43L)), row.names = c(NA, 
-144L), class = "data.frame")

以下是版本 1- 2018 年 9 月 25 日发布如果有人可以查看我整理的 ui 和服务器代码并帮助我解决问题，我将不胜感激（我也将不胜感激替代方法）：

library(shiny)
library(doBy)

# Define UI for data upload app ----
ui <- fluidPage(

  # App title ----
  titlePanel("Uploading Files"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # Input: Select a file ----
      fileInput("file1", "Choose CSV File",
                multiple = FALSE,
                accept = c("text/csv",
                           "text/comma-separated-values,text/plain",
                           ".csv")),

      # Selection for the drop down menus given the colnames 
      uiOutput('phenotype'), 
      uiOutput('treatment'), 
      uiOutput('factor1'), 
      uiOutput('factor2'),  

      # Horizontal line ----
      tags$hr(),

      # Input: Checkbox if file has header ----
      checkboxInput("header", "Header", TRUE),

      # Input: Select separator ----
      radioButtons("sep", "Separator",
                   choices = c(Comma = ",",
                               Semicolon = ";",
                               Tab = "\t"),
                   selected = ","),

      # Horizontal line ----
      tags$hr(),

      # Input: Select number of rows to display ----
      radioButtons("disp", "Display",
                   choices = c(Head = "head",
                               All = "all"),
                   selected = "head")#,

      #selectInput("phenotype","Phenotype:", choices = NULL),
      #selectInput("treatment","Treatment:", choices = NULL)


  ),

    # Main panel for displaying outputs ----
    mainPanel(
      img(src = "Logo.jpeg", height = 150, width = 150),
      # Output: Data file ----
      tableOutput("contents"), # in order to view the header
      verbatimTextOutput('summary'), # summary for uploaded DF
      verbatimTextOutput('BasicStats')
    )
  )
  )

# Define server logic to read selected file ----
server <- function(input, output, session) {

  # print out the summary ----
  # define the dataset that you will get a summary output for 
    myData <- reactive({
    inFile <- input$file1
    if (is.null(inFile)) return(NULL)
    data <- read.csv(inFile$datapath, header = TRUE)
    data
  }) 

########## Attempt to make a vector to output basic stats ###########  
    bs <- reactive({
        inFile <- input$file1
        x <- inFile$phenotype
        trt <- as.factor(inFile$treatment)
        factor1 <- as.factor(inFile$factor1)
        factor2 <- as.factor(inFile$factor2)
        #
        # make a new data frame with the information needed to get the 
          summary stats
        newDF <- data.frame(x,trt,factor1, factor2)
        newDF <- newDF[complete.cases(newDF),]
        result <- summaryBy( x ~ trt + factor1 + factor2, 
                  FUN = c(mean, sd, length), data = newDF)
        result$x.se <- result$x.sd/sqrt(result$x.length)
    })
###################### Table output info #########################
  output$summary <- renderPrint({
    summary(myData())
    })

  output$BasicStats <- renderPrint({
    bs()
  })

######## Make Drop down menus of header contents###############      
  output$phenotype <- renderUI({
    df <- myData()
    selectInput("phenotype", "Phenotype:",c("",names(df)))
  })

  output$treatment <- renderUI({
    df <- myData()
    selectInput("treatment", "Treatment:",c("",names(df)))
  })

  output$factor1 <- renderUI({
    df <- myData()
    selectInput("factor1", "Factor_1:",c("",names(df)))
  })

  output$factor2 <- renderUI({
    df <- myData()
    selectInput("factor2", "Factor_2:",c("",names(df)))
  })

  #output$factor3 <- renderUI({
  #  df <- myData()
   # selectInput("factor3", "Factor_3:",c("",names(df)))
 # })

 ##############To view header###########################  
  output$contents <- renderTable({

    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, head of that data file by default,
    # or all rows if selected, will be shown.

    req(input$file1)

    # when reading semicolon separated files,
    # having a comma separator causes `read.csv` to error
    tryCatch(
      {
        df <- read.csv(input$file1$datapath,
                       header = input$header,
                       sep = input$sep,
                       quote = input$quote)
      },
      error = function(e) {
        # return a safeError if a parsing error occurs
        stop(safeError(e))
      }
    )

    if(input$disp == "head") {
      return(head(df))
    }
    else {
      return(df)
    }

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

第 2 版于 2018 年 9 月 27 日更新：

library(shiny)
library(doBy)
library(dplyr)

# Define UI for data upload app ----
ui <- fluidPage(

  # App title ----
  titlePanel("Uploading Files"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # Input: Select a file ----
      fileInput("file1", "Choose CSV File",
                multiple = FALSE,
                accept = c("text/csv",
                           "text/comma-separated-values,text/plain",
                           ".csv")),

      # Selection for the drop down menus given the colnames 
      uiOutput('phenotype'), 
      uiOutput('treatment'), 
      uiOutput('factor1'), 
      uiOutput('factor2'), 
      #uiOutput('factor3'), 

      # Horizontal line ----
      tags$hr(),

      # Input: Checkbox if file has header ----
      checkboxInput("header", "Header", TRUE),

      # Input: Select separator ----
      radioButtons("sep", "Separator",
                   choices = c(Comma = ",",
                               Semicolon = ";",
                               Tab = "\t"),
                   selected = ","),

      # Horizontal line ----
      tags$hr(),

      # Input: Select number of rows to display ----
      radioButtons("disp", "Display",
                   choices = c(Head = "head",
                               All = "all"),
                   selected = "head")#,

      #selectInput("phenotype","Phenotype:", choices = NULL),
      #selectInput("treatment","Treatment:", choices = NULL)


  ),

    # Main panel for displaying outputs ----
    mainPanel(
      img(src = "joynLogo.jpeg", height = 150, width = 150),
      # Output: Data file ----
      tableOutput("contents"), # in order to view the header
      #tableOutput("BasicStats"),
      verbatimTextOutput('summary'), # summary statistics for data frame as a whole
      tableOutput('BasicStats')
    )
  )
  )


# Define server logic to read selected file ----
server <- function(input, output, session) {

  # print out the summary ----
  # define the dataset that you will get a summary output for 
    myData <- reactive({
              inFile <- input$file1
              if (is.null(inFile)) return(NULL)
              data <- read.csv(inFile$datapath, header = TRUE)
              data
  }) 


########## Attempt to make a vector to output basic stats ###########  
    # 9/27 I modified this code to subset the data given the selected 
    # variables
    # this code gives me the following error: "undefined columns 
    # selected". I suppose this gets me close, but no cigar! 

    #bs <- observeEvent(input$file1, { 
    bs <- reactive({
        req(input$file1)
        inFile <- input$file1
        x <- input$phenotype
        trt <- as.factor(input$treatment)
        factor1 <- as.factor(input$factor1)
        factor2 <- as.factor(input$factor2)
        #
        # make a new data frame with the information needed to get the summary stats
        subsetBy <- c(x,trt,factor1, factor2)
        newDF <- inFile[,subsetBy]
        newDF <- as.data.frame(newDF[complete.cases(newDF),])
        result <- summaryBy( x ~ trt + factor1 + factor2, FUN = c(mean, sd, length), data = newDF)
        result$x.se <- result$x.sd/sqrt(result$x.length)
        return(result)
    })

    # bs <- reactive({
    #   req(input$file1)
    #   inFile <- input$file1
    #   x <- input$phenotype
    #   trt <- as.factor(input$treatment)
    #   factor1 <- as.factor(input$factor1)
    #   factor2 <- as.factor(input$factor2)
    #   #newDF <-inFile[,c("x","trt","factor1","factor2")]
    #   #newDF <- select(inFile, input$x, as.factor(input$trt), as.factor(input$factor1), as.factor(input$factor2))
    #   newDF <- select(inFile, x, trt, factor1, factor2)
    #   #
    #   # make a new data frame with the information needed to get the summary stats
    #   #newDF <- data.frame(x,trt,factor1, factor2)
    #   newDF <- as.data.frame(newDF[complete.cases(newDF),])
    #   result <- summaryBy( x ~ trt + factor1 + factor2, FUN = c(mean, sd, length), data = newDF)
    #   result$x.se <- result$x.sd/sqrt(result$x.length)
    #   return(result)
    # })
###################### Table output info #########################
  output$summary <- renderPrint({
    summary(myData())
    })

  output$BasicStats <- renderTable(bs())

######### Make Drop down menus of header contents###############      
  output$phenotype <- renderUI({
    df <- myData()
    selectInput("phenotype", "Phenotype:",c("",names(df)))
  })

  output$treatment <- renderUI({
    df <- myData()
    selectInput("treatment", "Treatment:",c("",names(df)))
  })

  output$factor1 <- renderUI({
    df <- myData()
    selectInput("factor1", "Factor_1:",c("",names(df)))
  })

  output$factor2 <- renderUI({
    df <- myData()
    selectInput("factor2", "Factor_2:",c("",names(df)))
  })

  #output$factor3 <- renderUI({
  #  df <- myData()
   # selectInput("factor3", "Factor_3:",c("",names(df)))
 # })

 #########To view header#####################  
  output$contents <- renderTable({

    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, head of that data file by default,
    # or all rows if selected, will be shown.

    req(input$file1)

    # when reading semicolon separated files,
    # having a comma separator causes `read.csv` to error
    tryCatch(
      {
        df <- read.csv(input$file1$datapath,
                       header = input$header,
                       sep = input$sep,
                       quote = input$quote)
      },
      error = function(e) {
        # return a safeError if a parsing error occurs
        stop(safeError(e))
      }
    )

    if(input$disp == "head") {
      return(head(df))
    }
    else {
      return(df)
    }

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

【问题讨论】：

bs <- reactive({ inFile <- input$file1 这是我认为问题所在，因为没有输入，这将初始化为 null，因此参数不仅长度不同，而且没有长度。尝试使用 observeEvent 响应式环境，看看是否有帮助。
例如observeEvent(input$file1, { arguments })
谢谢@Chabo，应用您的建议后，我现在收到以下错误：找不到函数“bs”。我将以“observeEvent”开头的代码块移动到输出$BasicStats
我把以 'observeEvent' 开头的代码块移到了 output$BasicStats
你能分享一些可重现的数据吗？可能是你的 csv 文件？

标签： r shiny

【解决方案1】：

你已经得到了大部分。您需要做的是使用myData() 而不是input$file1 来创建汇总统计数据。将您的 bs() 更改为以下内容：

bs <- reactive({

    # Require all 4 input parameters be selected by the user
    req(input$phenotype, input$treatment, input$factor1, input$factor2)

    # Make a new data frame with the information needed to get the summary stats
    d <- data.frame(myData()[, input$phenotype], as.factor(myData()[, input$treatment]),
                    as.factor(myData()[, input$factor1]), as.factor(myData()[, input$factor2]))

    # Keep only non NA cases
    newDF <- as.data.frame(d[complete.cases(d),])

    # Rename columns
    colnames(newDF) <- c("x", "trt", "factor1", "factor2")

    # Extract summary stats
    result <- summaryBy( x ~ trt + factor1 + factor2, FUN = c(mean, sd, length), data = newDF)
    result$x.se <- result$x.sd/sqrt(result$x.length)

    return(result)
  })

【讨论】：