我正在为一群研究人员编写一个闪亮的应用程序，以使他们能够在进行更复杂的数据分析之前了解其数据。在某些实验中，对于一组经过特殊处理的重复样本，它们具有一组测量值（称为“表型”）。在其他实验中，实验水平稍微复杂一些，他们正在研究治疗方法和其他实验因素对表型的影响。
我想构建一个允许这些不同实验结构具有灵活性的应用程序，这需要条件语句，以便如果实验者只关心一种或多种因子水平对表型的影响，他们可以请参阅该度量的基本统计数据和描述性统计数据。现在，我编写了一个闪亮的应用程序，如果他们从每个下拉列中选择一个项目，则可以迫使他们查看其数据。有人可以帮忙吗？
在下面的数据集中，实验者可能只关心'N_level'或'N_level'+'Strain'或'N_level'+'Strain'+'inoc_met'的影响。在这三种情况中的每一种情况下，我都希望他们能够查看基本统计信息，并绘制出描述性统计数据图，以了解其实验可能是简单还是复杂。
一些可重现的数据是：
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")
这是闪亮的应用程序的代码
library(shiny)
library(doBy)
library(dplyr)
# Define UI for data upload app ----
ui <- fluidPage(
# App title ----
titlePanel("Upload File"),
# 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
p("Select relevant columns from data for basic statistics"),
uiOutput('phenotype'),
uiOutput('treatment'),
uiOutput('factor1'),
uiOutput('factor2'),
#uiOutput('factor3'),
#
selectInput("plot.type","Plot Type:",
list(boxplot = "boxplot", histogram = "histogram")
),
checkboxInput("show.points", "show points", TRUE),
# 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")
),
# Main panel for displaying outputs ----
mainPanel(
img(src = "joynLogo.jpeg", height = 150, width = 150),
# Output: Data file ----
p("View the head of your data"),
tableOutput("contents"), # in order to view the header
p("Take a look at your data overall, is all the information correct?"),
verbatimTextOutput('summary'), # summary statistics for data frame as a whole
p("Output basic statistics"),
tableOutput('BasicStats'),
h3(textOutput("caption")),
p("Note that the figure below is made taking into consideration a single factor level"),
uiOutput("plot")
)
)
)
# 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
})
########## make a vector to output basic stats ###########
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)
})
###################### Table output info #########################
output$summary <- renderPrint({
summary(myData())
})
output$BasicStats <- renderTable(bs())
############# Make Drop down menus of header contents##########
output$plot <- renderUI({
plotOutput("p")
})
# This will switch what is printed in the caption of the figure
output$caption<-renderText({
switch(input$plot.type,
"boxplot" = "Boxplot",
"histogram" = "Histogram")
})
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)
}
})
################################ Make figures ##############################
output$p <- renderPlot({
req(input$phenotype, input$treatment, input$factor1)
#plot types
plot.type<-switch(input$plot.type,
"boxplot" = geom_boxplot(aes(stat="identity")),
"histogram" = geom_histogram(alpha=0.5,position="identity")
)
if(input$plot.type=="boxplot") { #control for 1D or 2D graphs
p<-ggplot(myData(),
aes_string(
x = input$treatment,
y = input$phenotype,
fill = input$treatment
) # let type determine plotting
) + plot.type + labs(x = input$treatment, y = input$phenotype) + facet_grid(col = vars(myData()[,input$factor1]))
#+ facet_grid(col = vars(myData()[,input$factor]), scales = "free")
if(input$show.points==TRUE) # maybe do this for the factor level
{
p<-p+ geom_point(color='black',alpha=0.5, position = 'jitter')
}
} else {
#
p<-ggplot(myData(),
aes_string(
x = input$phenotype,
fill = input$treatment
)
) + plot.type + labs(x = input$phenotype) + facet_grid(col = vars(myData()[,input$factor1]))
}
p<-p+ .theme
print(p)
})
# set uploaded file
upload_data<-reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
#could also store in a reactiveValues
read.csv(inFile$datapath,
header = input$header,
sep = input$sep)
})
observeEvent(input$file1,{
inFile<<-upload_data()
})
}
###########################################################################
# Create Shiny app ----
shinyApp(ui, server)