【发布时间】：2021-03-09 21:24:18
【问题描述】：
我是 R 和 Shiny 的新手，所以请原谅我的无知。我有一个大数据集（184,171 个观察值和 10 个变量）作为小标题。我正在尝试创建一个使用此数据表的 Shiny 应用程序。用户选择一个计量器，然后选择一个要分析的变量、一个年份范围，然后他们是否希望该变量每年或每月汇总一次。根据输入，它将为选定的仪表创建 3 个图和一个位置图，以及汇总统计数据。运行我的用户界面部分时我没有问题。我知道问题出在我的服务器上。我想知道我是否在使用响应式 Values() 并正确观察 Event。
原始数据集是shinydata，我正在尝试制作一个根据用户输入进行过滤的反应性数据表。我的错误包括：
在传单输出框中显示 元数据没有适用的方法应用于反应性 Expr、反应性、函数类的对象
显示在摘要统计框中 数据必须是二维的（例如数据框或矩阵） -> 我知道这是因为我需要使用文本输出而不是数据表来进行汇总统计
显示在方框和时间序列图中输出 找不到对象年1
我已经为此苦苦挣扎了 3 天，并在网上搜索答案。任何见解将不胜感激！
# load libraries
library(shiny)
library(shinydashboard)
library(lubridate)
library(DT)
library(ggplot2)
library(dplyr)
library(leaflet)
library(tidyr)
# Read in datatable/tibble that was saved and exported as RDS
# from gauge script
# Modify table by removing columns SWE, RAIM, MOD_RUN
# and move date column from the last row to second row
shinydata = readRDS("C:/Users/.../shinydata.rds")
shinydata2 = shinydata[-c(5,7,11)]
shinydata2 = shinydata2 %>% relocate(DATE, .before = "YR")
> dput(head(shinydata2))
structure(list(GaugeID = c("06814000", "06814000", "06814000",
"06814000", "06814000", "06814000"), DATE = structure(c(4018,
4019, 4020, 4021, 4022, 4023), class = "Date"), YR = c(1981,
1981, 1981, 1981, 1981, 1981), MNTH = c(1, 1, 1, 1, 1, 1), DY = c(1,
2, 3, 4, 5, 6), PRCP = c(0, 0, 0, 0, 0, 0), TAIR = c(2.36, 0.71,
-1.62, -7.365, -3.03, 0.185), PET = c(0.4185, 0.3206, 0.3215,
0.3189, 0.3441, 0.4074), ET = c(0.4064, 0.31, 0.3102, 0.307,
0.3308, 0.3909), OBS_RUN = c(0.0171, 0.0171, 0.0154, 0.0137,
0.0137, 0.0154)), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
# shinydata2 with 10 variables and 184,171 observations
# Column number and header
# 1 - GaugeID (8 digit USGS gauge number, character)
# 2 - DATE (combined YR, MNTH, DY lubridate, date)
# 3 - YR (4 digit year, 1981 - 2014, numeric)
# 4 - MNTH (1 digit month, 1 - 12, numeric)
# 5 - DY (numeric )
# 6 - PRCP (precipitation (PRCP) in mm/day)
# 7 - TAIR (mean daily air temp (TAIR) in celcius)
# 8 - PET (potential evapotranspiration (PET) in mm/day)
# 9 - ET (evapotranspiration (ET) in mm/day from SAC model)
# 10 - OBS_RUN (observed runoff (OBS_RUN) in mm/day from USGS)
# Names correspond to column headers from shinydata2 (PRCP, TAIR, PET, ET, OB_RUN),
# columns 6 through 10, data all numeric
varNames = c("Precipitation",
"Air Temperature",
"Potential ET",
"Actual ET",
"Runoff")
# years are from 1981 to 2014
# column 3 in shinydata2, numeric
years = unique(shinydata2$YR)
months = c("January","February","March","April","May","June",
"July","August","September","October","November","December")
# 8 digit USGS gauge number, 15 total gauges
# column 1 in shinydata2 table, character
gaugeIds = unique(shinydata2$GaugeID)
gaugeNames = c("Turkey Creek near Seneca (06814000)",
"Soldier Creek near Delia (06889200)",
"Marais Des Cygnes River near Reading (06910800)",
"Dragoon Creek near Burlingame (06911900)",
"Chikaskia River near Corbin (07151500)",
"Cedar Creek near Cedar Point (07180500)",
"Timber Creek near Collinsville (08050800)",
"North Fork Guadalupe River near Kyle (08171300)",
"Blanco River near Kyle (08189500)",
"Mission River at Refugio (08189500)",
"East Fork White River near Fort Apache (09492400)",
"White River near Fort Apache (09494000)",
"Cibecue Creek near Chysotile (09497800)",
"Cherry Creek near Globe (09497980)",
"Los Gatos Creek near Coalinga (11224500)")
# gauge latitude values
gaugeLat = as.numeric(c(39.94778, 39.23833, 38.56701, 38.71069, 37.12891,
38.19645, 33.55455, 30.0641, 29.97938, 28.29195,
33.82227, 33.73644, 33.84311, 33.82783, 36.21468))
# gauge longitude values
gaugeLong = as.numeric(c(-96.10862, -95.8886, -95.96163, -95.83603, -97.60144,
-96.82458, -96.94723, -99.38699, -97.91, -97.27916,
-109.81454, -110.16677, -110.55761, -110.85623, -120.47071))
# combine gauge id, latitude and longitude into table
gaugeLatLong = tibble(x = gaugeIds, y = gaugeLat, z = gaugeLong)
# Define user interface
ui = dashboardPage(
dashboardHeader(title = "Test app"),
dashboardSidebar(
# choose which of the 15 gauges to analyze
selectizeInput(inputId = "gauge1",
label = "Choose USGS Stream Gauge",
choices = gaugeNames),
# choose one of the 5 variables
radioButtons(inputId = "variable1",
label = "Choose variable",
choices = varNames),
# select starting year and ending year (time span) for
# analysis, allows for smaller window of time
sliderInput(inputId = "yrRange1",
label = "Select the range of years:",
min = 1981, max = 2014,
value = c(1990, 2000)),
# View outputs for the variable on an annual time scale or monthly
# Monthly will be for the entire year range selected, for example
# range is 1990 - 2000, then the months will be Jan - Dec, totaled or
# averaged over the 10 year span
radioButtons(inputId = "temporal1",
label = "Temporal aggregation:",
choices = c("Annual", "Monthly"))
),
dashboardBody(
fluidRow(
# output summary statistics for the selected variable
# THIS IS NOT DATATABLE, should be TXT, fix
box(title = "Summary Statistics",
solidHeader = TRUE,
DT::dataTableOutput("statsTable"),
width = 4),
# output map that shows the location of the gauge selected
box(leafletOutput("map"), width = 8)
),
fluidRow(
# histogram plot for selected variable, over selected years annually or monthly
box(title = "Histogram",
solidHeader = TRUE,
plotOutput("histPlot"), width = 4),
# boxplot for selected variable over selected range, annually or monthly
box(title = "Box Plot",
solidHeader = TRUE,
plotOutput("boxPlot"),
width = 4),
# line plot for variable over years or months (for all selected years)
box(title = "Time Series Plot",
solidHeader = TRUE,
plotOutput("timePlot"), width = 4)
)
)
)
######### Server
server = function(input, output) {
# create reactive datatable that will update based on user
# inputs for gauge, variable, and time frame
values = reactiveValues(allData = NULL)
# filter datatable based on gauge selected, product table with only
# that gauge (based on shinydata2 table)
observeEvent(input$gauge1, {
values$allData = shinydata2 %>%
group_by(GaugeID, YR, MNTH) %>%
filter(GaugeID == input$gauge1)
})
# now filter the table for the selected gauge by the variable selected,
# table now has the gauge and one variable
observeEvent(input$variable1, {
if(input$variable1 == "Precipitation") {
values$allData = values$allData %>%
group_by(YR, MNTH) %>%
select(PRCP)
} else if(input$variable1 == "Air Temperature") {
values$allData = values$allData %>%
group_by(YR, MNTH) %>%
select(TAIR)
} else if(input$variable1 == "Potential ET") {
values$allData = values$allData %>%
group_by(YR, MNTH) %>%
select(PET)
} else if(input$variable1 == "Actual ET") {
values$allData = values$allData %>%
group_by(YR, MNTH) %>%
select(ET)
} else {
values$allData = values$allData %>%
group_by(YR, MNTH) %>%
select(OBS_RUN)
}
})
# filter the data table that has 1 gauge, 1 variable and select just
# the range of years based on slider
observeEvent(input$yrRange1, {
values$allData = values$allData %>%
group_by(YR, MNTH) %>%
filter(YR >= input$yrRange1[1] &
YR <= input$yrRange1[2])
})
# summary stats for the filtered table (one gauge, one variable, years)
# NOT TABLE
output$statsTable = renderDataTable({
summary(values$allData[[4]])
})
# create reactive to choose the lat/long from gaugeLatLong table
# that corresponds to the gauge selected
gaugeLoc = reactive({
gaugeLatLong %>%
filter(input$gauge1)
})
# show the gauge location on the map for the selected gauge only,
output$map = renderLeaflet({
leaflet(data = gaugeLoc) %>%
addProviderTiles("Jawg.Terrain") %>%
addMarkers(lng = ~z, lat = ~y, popup = ~x)
})
# plots
# selected annual aggregation
output$histPlot = renderPlot({
if (input$temporal1 == "Annual") {
annual1 = values$allData %>%
group_by(YR) %>%
summarise(yr_total = sum(values$allData[[4]]),
yr_mean = mean(values$allData[[4]]))
annualHistPlot = ggplot(data = annual1, aes(x = yr_total)) +
geom_histogram()
#selected monthly aggregation
} else {
month1 = values$allData %>%
group_by(MNTH) %>%
summarise(mnth_total = sum(values$allData[[4]]),
mnth_mean = mean(values$allData[[4]]))
monthHistPlot = ggplot(data = month1, aes(x = month_total)) +
geom_histogram()
}
})
output$timePlot = renderPlot({
if (input$temporal1 == "Annual") {
annual1 = values$allData %>%
group_by(YR) %>%
summarise(yr_total = sum(values$allData[[4]]),
yr_mean = mean(values$allData[[4]]))
annualTimePlot = ggplot(data = annual1, aes(x = YR)) +
geom_line(aes(y = yr_total))
} else {
month1 = values$allData %>%
group_by(MNTH) %>%
summarise(mnth_total = sum(values$allData[[4]]),
mnth_mean = mean(values$allData[[4]]))
monthTimePlot = ggplot(data = annual1, aes(x = MNTH)) +
geom_line(aes(y = mnth_total))
}
})
output$boxPlot = renderPlot({
if (input$temporal1 == "Annual") {
annual1 = values$allData %>%
group_by(YR) %>%
summarise(yr_total = sum(values$allData[[4]]),
yr_mean = mean(values$allData[[4]]))
annualboxPlot = ggplot(data = annual1, aes(x = YR, y = yr_total)) +
geom_boxplot()
} else {
month1 = values$allData %>%
group_by(MNTH) %>%
summarise(mnth_total = sum(values$allData[[4]]),
mnth_mean = mean(values$allData[[4]]))
monthboxPlot = ggplot(data = annual1, aes(x = MNTH, y = mnth_total)) +
geom_boxplot()
}
})
}
shinyApp(ui = ui, server = server)
【问题讨论】：
-
你能分享你的数据样本来制作一个可重复的例子吗？也许
dput(head(shinydata2))然后用结果编辑你的问题。 -
是的，我刚刚添加了那个。谢谢，我不知道该怎么做。