我正在开发一个Shiny App，以允许实验人员快速可视化并与他们的数据进行交互。目前，Shiny应用程序已编程为可做三件事：
在Shiny App中，能够上传并从上传的文件中选择列名，但是我没有获得所需的基本统计信息输出。作为参考，这是我称为“ 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-发布9/25/18 如果有人可以看一下我所编写的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更新于9/27/18：
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)
答案 0 :(得分：0)
大多数情况下，您已经掌握了它。您需要做的是使用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)
})