rep 中的错误：尝试复制 'closure' 类型的对象（if 语句中的箱线图）
Error in rep: attempt to replicate an object of type 'closure' (Boxplots in if statements)
我有一个代码可以制作箱线图制作工具。它非常接近工作（感谢这个网站上的一群人）。我现在遇到的问题是，每当我 运行 代码时，我都会收到 Error in rep: attempt to replicate an object of type 'closure' 警告。堆栈跟踪显示它直接来自制作箱线图的代码行（以 运行s 为准）。问题是我不能在 if 语句中包含箱线图吗？我觉得那不是真的。您能提供的任何帮助将不胜感激。这是代码：
library(shiny)
All_Data <- data.frame(
Name = as.character(c("Jeff","Bob","Greg")),
Year = c(2015,2015,2015),
Bacteria = c("A","B","C"),
Site = c("C1","C1","C1"),
Percents = c(1,2,4),
stringsasfactors = TRUE
)
ndata <-data.frame(
Name = as.character("Preset"),
Year = c("0"),
Bacteria = as.factor(c("0")),
Site = as.factor(c("0")),
Percents = as.numeric(c("0")),
stringsAsFactors = TRUE
)
Names <- c("Jeff", "Bob", "Greg")
Years <- c("0")
names(Years)<-c("2015 C2")
Sites <- c("","C1")
# Define UI for application
ui <- fluidPage(
# Application title
titlePanel("ISAMR DNA Group Boxplot Maker"),
# Sidebar
sidebarLayout(
sidebarPanel(width = 4,
h3("Which Data Sets Would You Like to Compare?"),
selectInput("Set1", "", choices = c(Sites, Years, Names)),
selectInput("Set2", "",choices = c(Sites, Years, Names)),
selectInput("factor","Based on Which Factor?", choices = c("Year", "Site", "Bacteria", "Site by Year", "Bacteria by Year", "Bacteria by Site by Year")),
textInput("title", h4("Title"), placeholder = "Enter title..."),
numericInput("numcol","How many colors?",value=1,min=1,max=5),
h4("Pick the colors you want, leave the rest blank."),
selectInput("col1","",choices = c("",colors())),
selectInput("col2","",choices = c("",colors())),
selectInput("col3","",choices = c("",colors())),
selectInput("col4","",choices = c("",colors())),
selectInput("col5","",choices = c("",colors())),
actionButton("Submit", "Submit")
),
# Show a chosen plot
mainPanel(
#uiOutput("data"),
DT::dataTableOutput("data"),
plotOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
createframe<-eventReactive(input$Submit, {req(input$Submit)
if (input$Set1 %in% Names & input$Set2 %in% Names){
ndata <- filter(All_Data, All_Data$Name == input$Set1 | All_Data$Name == input$Set2)
}
else if (input$Set1 %in% Names & input$Set1 %in% Years){
ndata <- filter(All_Data, All_Data$Name == input$Set1 | All_Data$Year == input$Set2)
}
else if (input$Set1 %in% Names & input$Set1 %in% Sites){
ndata <- filter(All_Data, All_Data$Name == input$Set1 | All_Data$Site == input$Set2)
}
else if (input$Set1 %in% Years & input$Set1 %in% Names){
ndata <- filter(All_Data, All_Data$Site == input$Set1 | All_Data$Name == input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Years){
ndata <- filter(All_Data, All_Data$Year == input$Set1 | All_Data$Year == input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Sites){
ndata <- filter(All_Data, All_Data$Year == input$Set1 | All_Data$Site == input$Set2)
}
else if (input$Set1 %in% Sites & input$Set1 %in% Names){
ndata <- filter(All_Data, All_Data$Site == input$Set1 | All_Data$Name == input$Set2)
}
else if (input$Set1 %in% Sites & input$Set1 %in% Years){
ndata <- filter(All_Data, All_Data$Site == input$Set1 | All_Data$Year == input$Set2)
}
else if (input$Set1 %in% Sites & input$Set1 %in% Sites){
ndata <- filter(All_Data, All_Data$Site == input$Set1 | All_Data$Site == input$Set2)
} })
output$data <- DT::renderDataTable({
createframe()
})
observeEvent(input$numcol,{req(input$numcol)
if (input$numcol == 1){coll<-c(input$col1)}
if (input$numcol == 2){coll<-c(input$col1,input$col2)}
if (input$numcol == 3){coll<-c(input$col1,input$col2,input$col13)}
if (input$numcol == 4){coll<-c(input$col1,input$col2,input$col3,input$col4)}
if (input$numcol == 5){coll<-c(input$col1,input$col2,input$col3,input$col4,input$col5)}
})
observeEvent(input$factor,{req(input$factor)
output$plot <- renderPlot(
if (input$factor == "Year"){
boxplot(Percents ~ Year, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Site"){
boxplot(Percents ~ Site, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Bacteria"){
boxplot(Percents ~ Bacteria, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Site by Year"){
boxplot(Percents ~ Year%in%Site, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Bacteria by Year"){
boxplot(Percents ~ Year%in%Bacteria, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Bacteria by Site by Year"){
boxplot(Percents ~ Year%in%Site%in%Bacteria, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
)})
}
# Run the application
shinyApp(ui = ui, server = server)
(非真实数据)
sessionInfo()
R version 4.0.2 (2020-06-22)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 18363)
Matrix products: default
locale:
[1] LC_COLLATE=English_United States.1252 LC_CTYPE=English_United States.1252 LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C LC_TIME=English_United States.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] ggrepel_0.8.2 ggthemes_4.2.0 shiny_1.5.0 dslabs_0.7.3 forcats_0.5.0 stringr_1.4.0 dplyr_1.0.0 purrr_0.3.4 readr_1.3.1
[10] tidyr_1.1.0 tibble_3.0.3 ggplot2_3.3.2 tidyverse_1.3.0
loaded via a namespace (and not attached):
[1] Rcpp_1.0.5 lubridate_1.7.9 assertthat_0.2.1 digest_0.6.25 mime_0.9 R6_2.4.1 cellranger_1.1.0 backports_1.1.7
[9] reprex_0.3.0 httr_1.4.1 pillar_1.4.6 rlang_0.4.7 readxl_1.3.1 rstudioapi_0.11 blob_1.2.1 DT_0.14
[17] labeling_0.3 htmlwidgets_1.5.1 munsell_0.5.0 tinytex_0.24 broom_0.7.0 compiler_4.0.2 httpuv_1.5.4 modelr_0.1.8
[25] xfun_0.15 pkgconfig_2.0.3 htmltools_0.5.0 sourcetools_0.1.7 tidyselect_1.1.0 fansi_0.4.1 crayon_1.3.4 dbplyr_1.4.4
[33] withr_2.2.0 later_1.1.0.1 grid_4.0.2 jsonlite_1.7.0 xtable_1.8-4 gtable_0.3.0 lifecycle_0.2.0 DBI_1.1.0
[41] magrittr_1.5 scales_1.1.1 cli_2.0.2 stringi_1.4.6 farver_2.0.3 fs_1.4.2 promises_1.1.1 xml2_1.3.2
[49] ellipsis_0.3.1 generics_0.0.2 vctrs_0.3.2 tools_4.0.2 glue_1.4.1 hms_0.5.3 crosstalk_1.1.0.1 rsconnect_0.8.16
[57] fastmap_1.0.1 yaml_2.2.1 colorspace_1.4-1 rvest_0.3.5 haven_2.3.1
堆栈跟踪：
Warning: Error in rep: attempt to replicate an object of type 'closure'
174: pcycle
173: bxp
171: boxplot.default
169: boxplot.formula
167: renderPlot [C:\Users\pferr\Desktop\Test/app.R#102]
165: func
125: drawPlot
111: <reactive:plotObj>
95: drawReactive
82: origRenderFunc
81: output$plot
1: runApp
你有几个问题。首先，颜色定义是一个问题。缺少选择也导致了问题。所以，我把它变成了一个反应性的。其次，您在箱线图中使用 ndata 作为数据。一旦你修复它们，它就可以正常工作。请看下面的代码。
library(shiny)
ndata <-data.frame(
Name = as.character("Preset"),
Year = c("0"),
Bacteria = as.factor(c("0")),
Site = as.factor(c("0")),
Percents = as.numeric(c("0")),
stringsAsFactors = TRUE
)
Names <- c("Jeff", "Bob", "Greg")
Years <- c("0")
names(Years)<-c("2015 C2")
Sites <- c("","C1")
# Define UI for application
ui <- fluidPage(
# Application title
titlePanel("ISAMR DNA Group Boxplot Maker"),
# Sidebar
sidebarLayout(
sidebarPanel(width = 4,
h3("Which Data Sets Would You Like to Compare?"),
selectInput("Set1", "", choices = c(Sites, Years, Names)),
selectInput("Set2", "",choices = c(Sites, Years, Names)),
selectInput("factor","Based on Which Factor?",
choices = c("Year", "Site", "Bacteria", "Site by Year", "Bacteria by Year", "Bacteria by Site by Year")),
textInput("title", h4("Title"), placeholder = "Enter title..."),
numericInput("numcol","How many colors?",value=1,min=1,max=5),
h4("Pick the colors you want, leave the rest blank."),
selectInput("col1","",choices = c(colors())),
selectInput("col2","",choices = c(colors())),
selectInput("col3","",choices = c(colors())),
selectInput("col4","",choices = c(colors())),
selectInput("col5","",choices = c(colors())),
actionButton("Submit", "Submit")
),
# Show a chosen plot
mainPanel(
#uiOutput("data"),
DT::dataTableOutput("data")
,plotOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
All_Data <- data.frame(
Name = as.character(c("Jeff","Bob","Greg")),
Year = c(2015,2015,2015),
Bacteria = c("A","B","C"),
Site = c("C1","C1","C1"),
Percents = c(1,2,4),
stringsAsFactors = TRUE
)
dframe<-reactive({
req(input$Set1,input$Set2)
if (input$Set1 %in% Names & input$Set2 %in% Names){
ndata <- filter(All_Data, All_Data$Name %in% input$Set1 | All_Data$Name %in% input$Set2)
}
else if (input$Set1 %in% Names & input$Set2 %in% Years){
ndata <- filter(All_Data, All_Data$Name %in% input$Set1 | All_Data$Year %in% input$Set2)
}
else if (input$Set1 %in% Names & input$Set2 %in% Sites){
ndata <- filter(All_Data, All_Data$Name %in% input$Set1 | All_Data$Site %in% input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Names){
ndata <- filter(All_Data, All_Data$Site %in% input$Set1 | All_Data$Name %in% input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Years){
ndata <- filter(All_Data, All_Data$Year %in% input$Set1 | All_Data$Year %in% input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Sites){
ndata <- filter(All_Data, All_Data$Year %in% input$Set1 | All_Data$Site %in% input$Set2)
}
else if (input$Set1 %in% Sites & input$Set2 %in% Names){
ndata <- filter(All_Data, All_Data$Site %in% input$Set1 | All_Data$Name %in% input$Set2)
}
else if (input$Set1 %in% Sites & input$Set2 %in% Years){
ndata <- filter(All_Data, All_Data$Site %in% input$Set1 | All_Data$Year %in% input$Set2)
}
else if (input$Set1 %in% Sites & input$Set2 %in% Sites){
ndata <- filter(All_Data, All_Data$Site %in% input$Set1 | All_Data$Site %in% input$Set2)
}else{ndata <- NULL}
return(ndata)
})
output$data <- DT::renderDataTable({
dframe()
})
coll <- reactive({
req(input$numcol)
if (is.null(input$numcol)) {coll <- c("red")
}else if (input$numcol == 1) {coll <- c(input$col1)
}else if (input$numcol == 2) {coll <- c(input$col1,input$col2)
}else if (input$numcol == 3) {coll <- c(input$col1,input$col2,input$col13)
}else if (input$numcol == 4) {coll <- c(input$col1,input$col2,input$col3,input$col4)
}else if (input$numcol == 5) {coll <- c(input$col1,input$col2,input$col3,input$col4,input$col5)
}else {coll <- c("orange")}
coll
})
observeEvent(input$Submit, {
req(input$factor,input$Submit)
if (is.null(input$factor) | input$Submit==0){
return(NULL)
}else{
output$plot <- renderPlot({
if (input$factor == "Year"){
boxplot(Percents ~ Year, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Site"){
boxplot(Percents ~ Site, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Bacteria"){
boxplot(Percents ~ Bacteria, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Site by Year"){
boxplot(Percents ~ Year%in%Site, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Bacteria by Year"){
boxplot(Percents ~ Year%in%Bacteria, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Bacteria by Site by Year"){
boxplot(Percents ~ Year%in%Site%in%Bacteria, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else {return(NULL)}
})
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
我有一个代码可以制作箱线图制作工具。它非常接近工作（感谢这个网站上的一群人）。我现在遇到的问题是，每当我 运行 代码时，我都会收到 Error in rep: attempt to replicate an object of type 'closure' 警告。堆栈跟踪显示它直接来自制作箱线图的代码行（以 运行s 为准）。问题是我不能在 if 语句中包含箱线图吗？我觉得那不是真的。您能提供的任何帮助将不胜感激。这是代码：
library(shiny)
All_Data <- data.frame(
Name = as.character(c("Jeff","Bob","Greg")),
Year = c(2015,2015,2015),
Bacteria = c("A","B","C"),
Site = c("C1","C1","C1"),
Percents = c(1,2,4),
stringsasfactors = TRUE
)
ndata <-data.frame(
Name = as.character("Preset"),
Year = c("0"),
Bacteria = as.factor(c("0")),
Site = as.factor(c("0")),
Percents = as.numeric(c("0")),
stringsAsFactors = TRUE
)
Names <- c("Jeff", "Bob", "Greg")
Years <- c("0")
names(Years)<-c("2015 C2")
Sites <- c("","C1")
# Define UI for application
ui <- fluidPage(
# Application title
titlePanel("ISAMR DNA Group Boxplot Maker"),
# Sidebar
sidebarLayout(
sidebarPanel(width = 4,
h3("Which Data Sets Would You Like to Compare?"),
selectInput("Set1", "", choices = c(Sites, Years, Names)),
selectInput("Set2", "",choices = c(Sites, Years, Names)),
selectInput("factor","Based on Which Factor?", choices = c("Year", "Site", "Bacteria", "Site by Year", "Bacteria by Year", "Bacteria by Site by Year")),
textInput("title", h4("Title"), placeholder = "Enter title..."),
numericInput("numcol","How many colors?",value=1,min=1,max=5),
h4("Pick the colors you want, leave the rest blank."),
selectInput("col1","",choices = c("",colors())),
selectInput("col2","",choices = c("",colors())),
selectInput("col3","",choices = c("",colors())),
selectInput("col4","",choices = c("",colors())),
selectInput("col5","",choices = c("",colors())),
actionButton("Submit", "Submit")
),
# Show a chosen plot
mainPanel(
#uiOutput("data"),
DT::dataTableOutput("data"),
plotOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
createframe<-eventReactive(input$Submit, {req(input$Submit)
if (input$Set1 %in% Names & input$Set2 %in% Names){
ndata <- filter(All_Data, All_Data$Name == input$Set1 | All_Data$Name == input$Set2)
}
else if (input$Set1 %in% Names & input$Set1 %in% Years){
ndata <- filter(All_Data, All_Data$Name == input$Set1 | All_Data$Year == input$Set2)
}
else if (input$Set1 %in% Names & input$Set1 %in% Sites){
ndata <- filter(All_Data, All_Data$Name == input$Set1 | All_Data$Site == input$Set2)
}
else if (input$Set1 %in% Years & input$Set1 %in% Names){
ndata <- filter(All_Data, All_Data$Site == input$Set1 | All_Data$Name == input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Years){
ndata <- filter(All_Data, All_Data$Year == input$Set1 | All_Data$Year == input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Sites){
ndata <- filter(All_Data, All_Data$Year == input$Set1 | All_Data$Site == input$Set2)
}
else if (input$Set1 %in% Sites & input$Set1 %in% Names){
ndata <- filter(All_Data, All_Data$Site == input$Set1 | All_Data$Name == input$Set2)
}
else if (input$Set1 %in% Sites & input$Set1 %in% Years){
ndata <- filter(All_Data, All_Data$Site == input$Set1 | All_Data$Year == input$Set2)
}
else if (input$Set1 %in% Sites & input$Set1 %in% Sites){
ndata <- filter(All_Data, All_Data$Site == input$Set1 | All_Data$Site == input$Set2)
} })
output$data <- DT::renderDataTable({
createframe()
})
observeEvent(input$numcol,{req(input$numcol)
if (input$numcol == 1){coll<-c(input$col1)}
if (input$numcol == 2){coll<-c(input$col1,input$col2)}
if (input$numcol == 3){coll<-c(input$col1,input$col2,input$col13)}
if (input$numcol == 4){coll<-c(input$col1,input$col2,input$col3,input$col4)}
if (input$numcol == 5){coll<-c(input$col1,input$col2,input$col3,input$col4,input$col5)}
})
observeEvent(input$factor,{req(input$factor)
output$plot <- renderPlot(
if (input$factor == "Year"){
boxplot(Percents ~ Year, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Site"){
boxplot(Percents ~ Site, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Bacteria"){
boxplot(Percents ~ Bacteria, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Site by Year"){
boxplot(Percents ~ Year%in%Site, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Bacteria by Year"){
boxplot(Percents ~ Year%in%Bacteria, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
else if (input$factor == "Bacteria by Site by Year"){
boxplot(Percents ~ Year%in%Site%in%Bacteria, data = ndata, main = input$title, ylab = "Relative Abundance", col = coll)
}
)})
}
# Run the application
shinyApp(ui = ui, server = server)
(非真实数据)
sessionInfo()
R version 4.0.2 (2020-06-22)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 18363)
Matrix products: default
locale:
[1] LC_COLLATE=English_United States.1252 LC_CTYPE=English_United States.1252 LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C LC_TIME=English_United States.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] ggrepel_0.8.2 ggthemes_4.2.0 shiny_1.5.0 dslabs_0.7.3 forcats_0.5.0 stringr_1.4.0 dplyr_1.0.0 purrr_0.3.4 readr_1.3.1
[10] tidyr_1.1.0 tibble_3.0.3 ggplot2_3.3.2 tidyverse_1.3.0
loaded via a namespace (and not attached):
[1] Rcpp_1.0.5 lubridate_1.7.9 assertthat_0.2.1 digest_0.6.25 mime_0.9 R6_2.4.1 cellranger_1.1.0 backports_1.1.7
[9] reprex_0.3.0 httr_1.4.1 pillar_1.4.6 rlang_0.4.7 readxl_1.3.1 rstudioapi_0.11 blob_1.2.1 DT_0.14
[17] labeling_0.3 htmlwidgets_1.5.1 munsell_0.5.0 tinytex_0.24 broom_0.7.0 compiler_4.0.2 httpuv_1.5.4 modelr_0.1.8
[25] xfun_0.15 pkgconfig_2.0.3 htmltools_0.5.0 sourcetools_0.1.7 tidyselect_1.1.0 fansi_0.4.1 crayon_1.3.4 dbplyr_1.4.4
[33] withr_2.2.0 later_1.1.0.1 grid_4.0.2 jsonlite_1.7.0 xtable_1.8-4 gtable_0.3.0 lifecycle_0.2.0 DBI_1.1.0
[41] magrittr_1.5 scales_1.1.1 cli_2.0.2 stringi_1.4.6 farver_2.0.3 fs_1.4.2 promises_1.1.1 xml2_1.3.2
[49] ellipsis_0.3.1 generics_0.0.2 vctrs_0.3.2 tools_4.0.2 glue_1.4.1 hms_0.5.3 crosstalk_1.1.0.1 rsconnect_0.8.16
[57] fastmap_1.0.1 yaml_2.2.1 colorspace_1.4-1 rvest_0.3.5 haven_2.3.1
堆栈跟踪：
Warning: Error in rep: attempt to replicate an object of type 'closure'
174: pcycle
173: bxp
171: boxplot.default
169: boxplot.formula
167: renderPlot [C:\Users\pferr\Desktop\Test/app.R#102]
165: func
125: drawPlot
111: <reactive:plotObj>
95: drawReactive
82: origRenderFunc
81: output$plot
1: runApp
你有几个问题。首先，颜色定义是一个问题。缺少选择也导致了问题。所以，我把它变成了一个反应性的。其次，您在箱线图中使用 ndata 作为数据。一旦你修复它们，它就可以正常工作。请看下面的代码。
library(shiny)
ndata <-data.frame(
Name = as.character("Preset"),
Year = c("0"),
Bacteria = as.factor(c("0")),
Site = as.factor(c("0")),
Percents = as.numeric(c("0")),
stringsAsFactors = TRUE
)
Names <- c("Jeff", "Bob", "Greg")
Years <- c("0")
names(Years)<-c("2015 C2")
Sites <- c("","C1")
# Define UI for application
ui <- fluidPage(
# Application title
titlePanel("ISAMR DNA Group Boxplot Maker"),
# Sidebar
sidebarLayout(
sidebarPanel(width = 4,
h3("Which Data Sets Would You Like to Compare?"),
selectInput("Set1", "", choices = c(Sites, Years, Names)),
selectInput("Set2", "",choices = c(Sites, Years, Names)),
selectInput("factor","Based on Which Factor?",
choices = c("Year", "Site", "Bacteria", "Site by Year", "Bacteria by Year", "Bacteria by Site by Year")),
textInput("title", h4("Title"), placeholder = "Enter title..."),
numericInput("numcol","How many colors?",value=1,min=1,max=5),
h4("Pick the colors you want, leave the rest blank."),
selectInput("col1","",choices = c(colors())),
selectInput("col2","",choices = c(colors())),
selectInput("col3","",choices = c(colors())),
selectInput("col4","",choices = c(colors())),
selectInput("col5","",choices = c(colors())),
actionButton("Submit", "Submit")
),
# Show a chosen plot
mainPanel(
#uiOutput("data"),
DT::dataTableOutput("data")
,plotOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
All_Data <- data.frame(
Name = as.character(c("Jeff","Bob","Greg")),
Year = c(2015,2015,2015),
Bacteria = c("A","B","C"),
Site = c("C1","C1","C1"),
Percents = c(1,2,4),
stringsAsFactors = TRUE
)
dframe<-reactive({
req(input$Set1,input$Set2)
if (input$Set1 %in% Names & input$Set2 %in% Names){
ndata <- filter(All_Data, All_Data$Name %in% input$Set1 | All_Data$Name %in% input$Set2)
}
else if (input$Set1 %in% Names & input$Set2 %in% Years){
ndata <- filter(All_Data, All_Data$Name %in% input$Set1 | All_Data$Year %in% input$Set2)
}
else if (input$Set1 %in% Names & input$Set2 %in% Sites){
ndata <- filter(All_Data, All_Data$Name %in% input$Set1 | All_Data$Site %in% input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Names){
ndata <- filter(All_Data, All_Data$Site %in% input$Set1 | All_Data$Name %in% input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Years){
ndata <- filter(All_Data, All_Data$Year %in% input$Set1 | All_Data$Year %in% input$Set2)
}
else if (input$Set1 %in% Years & input$Set2 %in% Sites){
ndata <- filter(All_Data, All_Data$Year %in% input$Set1 | All_Data$Site %in% input$Set2)
}
else if (input$Set1 %in% Sites & input$Set2 %in% Names){
ndata <- filter(All_Data, All_Data$Site %in% input$Set1 | All_Data$Name %in% input$Set2)
}
else if (input$Set1 %in% Sites & input$Set2 %in% Years){
ndata <- filter(All_Data, All_Data$Site %in% input$Set1 | All_Data$Year %in% input$Set2)
}
else if (input$Set1 %in% Sites & input$Set2 %in% Sites){
ndata <- filter(All_Data, All_Data$Site %in% input$Set1 | All_Data$Site %in% input$Set2)
}else{ndata <- NULL}
return(ndata)
})
output$data <- DT::renderDataTable({
dframe()
})
coll <- reactive({
req(input$numcol)
if (is.null(input$numcol)) {coll <- c("red")
}else if (input$numcol == 1) {coll <- c(input$col1)
}else if (input$numcol == 2) {coll <- c(input$col1,input$col2)
}else if (input$numcol == 3) {coll <- c(input$col1,input$col2,input$col13)
}else if (input$numcol == 4) {coll <- c(input$col1,input$col2,input$col3,input$col4)
}else if (input$numcol == 5) {coll <- c(input$col1,input$col2,input$col3,input$col4,input$col5)
}else {coll <- c("orange")}
coll
})
observeEvent(input$Submit, {
req(input$factor,input$Submit)
if (is.null(input$factor) | input$Submit==0){
return(NULL)
}else{
output$plot <- renderPlot({
if (input$factor == "Year"){
boxplot(Percents ~ Year, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Site"){
boxplot(Percents ~ Site, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Bacteria"){
boxplot(Percents ~ Bacteria, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Site by Year"){
boxplot(Percents ~ Year%in%Site, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Bacteria by Year"){
boxplot(Percents ~ Year%in%Bacteria, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else if (input$factor == "Bacteria by Site by Year"){
boxplot(Percents ~ Year%in%Site%in%Bacteria, data = dframe(), main = input$title, ylab = "Relative Abundance", col = coll())
}else {return(NULL)}
})
}
})
}
# Run the application
shinyApp(ui = ui, server = server)