我正在尝试设计一个r闪亮的脚本，该脚本汇集数据并将其汇总在表中。目的是让几个查看者查看不知道如何使用R的结果，因此我打算将其发布到我们的本地服务器上。我正在使用Windows 7和RStudio版本1.1.419。
我遇到的问题是，尽管返回了我想要的数据表，包括一个用于更新三个selectInput变量的反应性组件，但是r闪亮脚本似乎可以正常运行，但是会引发错误。我以iris中的修改数据集为例。
数据：
library(shiny)
library(ggplot2)
library(DT)
library(dplyr)
library(lubridate)
date <- rep(seq(dmy("01-Jun-18"), by = "day", length.out = 5), each = 30)
df <- iris
df2 <- cbind(df, date, Check = c("Yes", "No"), Site = c("RCH", "ARH", "SMH"))
df2[1:75, "Check"] <- "Yes"
df2$Species <- as.character(df2$Species)
df2$Check <- as.character(df2$Check)
df2$Site <- as.character(df2$Site)
str(df2)
ui.R
ui <- shinyUI(fluidPage(
titlePanel("Dynamic user interface"),
sidebarLayout(
sidebarPanel(
uiOutput("daterange"),
uiOutput("dat1"),
uiOutput("dat2"),
uiOutput("dat3")
),
mainPanel(
dataTableOutput("table")
)
)
))
服务器。R
server <- shinyServer(function(output, input, session)({
output$daterange <- renderUI({
dateRangeInput("daterange", "Select date range:", start = min(df2$date), end = max(df2$date))
})
r.daterange <- reactive({
df2 %>% filter(date >= input$daterange[1] & date <= input$daterange[2])
})
output$dat1 <- renderUI({
selectInput ("dat1", "Choose Species",
choices = c("<All>", as.character(r.daterange()$Species)),
selected=1,
multiple = FALSE)
})
r.species <- reactive({
df2 %>%
filter(Species == input$dat1)
})
output$dat2 <- renderUI({
selectInput("dat2", "Select Check",
choices = c("<All>", as.character(r.species()$Check)),
selected = 1,
multiple = FALSE)
})
r.check <- reactive({
df2 %>%
filter(Species == input$dat1 & Check == input$dat2)
})
output$dat3 <- renderUI({
selectInput("dat3", "Select Site",
if(input$dat1 == "<All>")
choices = c("<All>", as.character(r.check()$Site)),
selected = 1,
multiple = FALSE)
})
output$table <- renderDataTable({
tabledata <- do.call(data.frame,aggregate(Sepal.Length~Species*Check*Site,
df2 %>% filter(
if(input$dat1 == "<All>" & input$dat2 == "<All>" & input$dat3 == "<All>"){
date >= input$daterange[1] & date <= input$daterange[2] & Species == df2$Species & Check == df2$Check & Site == df2$Site
}
else if(input$dat1 == "<All>" & input$dat2 == "<All>" & input$dat3 != "<All>"){
date >= input$daterange[1] & date <= input$daterange[2] & Species == df2$Species & Check == df2$Check & Site == input$dat3
}
else if(input$dat1 == "<All>" & input$dat2 != "<All>" & input$dat3 != "<All>"){
date >= input$daterange[1] & date <= input$daterange[2] & Species == df2$Species & Check == input$dat2 & Site == input$dat3
}
else if(input$dat1 != "<All>" & input$dat2 != "<All>" & input$dat3 != "<All>"){
date >= input$daterange[1] & date <= input$daterange[2] & Species == input$dat1 & Check == input$dat2 & Site == input$dat3
}
else if(input$dat1 != "<All>" & input$dat2 == "<All>" & input$dat3 == "<All>"){
date >= input$daterange[1] & date <= input$daterange[2] & Species == input$dat1 & Check == df2$Check & Site == df2$Site
}
else if(input$dat1 != "<All>" & input$dat2 != "<All>" & input$dat3 == "<All>"){
date >= input$daterange[1] & date <= input$daterange[2] & Species == input$dat1 & Check == input$dat2 & Site == df2$Site
}
else if(input$dat1 == "<All>" & input$dat2 != "<All>" & input$dat3 == "<All>"){
date >= input$daterange[1] & date <= input$daterange[2] & Species == df2$Species & Check == input$dat2 & Site == df2$Site
}
else if(input$dat1 != "<All>" & input$dat2 == "<All>" & input$dat3 != "<All>"){
date >= input$daterange[1] & date <= input$daterange[2] & Species == input$dat1 & Check == df2$Check & Site == input$dat3
}
), mean))
return(tabledata)
})
}
))
shinyApp(ui = ui, server = server)
引发的错误如下：
Warning: Error in filter_impl: Evaluation error: argument is of length zero.
Stack trace (innermost first):
106: <Anonymous>
105: stop
104: filter_impl
103: filter.tbl_df
102: filter
101: as.data.frame
100: filter.data.frame
99: filter
98: function_list[[k]]
97: withVisible
96: freduce
95: _fseq
94: eval
93: eval
92: withVisible
91: %>%
90: eval
89: eval
88: aggregate.formula
87: aggregate
86: do.call [#47]
85: exprFunc [#47]
84: widgetFunc
83: func
82: origRenderFunc
81: renderFunc
80: origRenderFunc
79: output$table
4: <Anonymous>
3: do.call
2: print.shiny.appobj
1: <Promise>
我怀疑这与我设计反应函数的方式有关，但是我无法弄清楚。即使该脚本似乎最终可以正常工作，我还是会犹豫是否实现该脚本。
非常感谢您的帮助！