我正在构建一个闪亮的预算闪亮应用程序，它会提示用户输入数据，例如花费的费用类型、金额和描述。仅当用户输入了至少一个类别为“储蓄”的数据条目时，我想在应用程序的第二个面板中显示一个线图，标记为“每月预算”。我尝试过在满足条件时隐藏/显示绘图等事情，但似乎我总是使用这种方法收到 NaN 错误消息。因此，我正在尝试使用 conditionalPanel() 来完成这项任务。我注意到与此类似的帖子，但这是我发现的第一个案例，其中 conditionalPanel() 处理用户输入的数据而不是给定的数据集。
这是代码：
# Libraries
library(shiny)
library(ggplot2)
library(shinycssloaders)
library(colortools)
library(shinythemes)
library(DT)
library(tidyverse)
library(kableExtra)
library(formattable)
library(xts)
# Creating Contrasting Colors For Buckets
bucket_colors <- wheel("skyblue", num = 6)
# Define UI for application that draws a histogram
ui <- fluidPage(
# theme = shinytheme("spacelab"),
shinythemes::themeSelector(),
## Application Title
titlePanel("2021 Budgeting & Finances"),
tags$em("By:"),
tags$hr(),
navbarPage("", id = "Budget",
tabPanel("Data Entry",
div(class = "outer",
# Sidebar Layout
sidebarLayout(
sidebarPanel(
selectInput("Name",
label = "Name:",
choices = c("","Jack", "Jill")),
selectInput("Bucket",
label = "Item Bucket:",
choices = c("","Essential", "Non-Essential", "Savings", "Rent/Bills", "Trip", "Other")),
textInput("Item",
label = "Item Name:",
placeholder = "Ex: McDonald's"),
shinyWidgets::numericInputIcon("Amount",
"Amount:",
value = 0,
step = 0.01,
min = 0,
max = 1000000,
icon = list(icon("dollar"), NULL)),
dateInput("Date",
label = "Date",
value = Sys.Date(),
min = "2021-05-01",
max = "2022-12-31",
format = "M-d-yyyy"),
actionButton("Submit", "Submit", class = "btn btn-primary"),
downloadButton("Download", "Download")),
# Show a plot of the generated distribution
mainPanel(
tableOutput("PreviewTable")
)
)
)
),
############ THIS IS WHERE THE ERROR HAPPENS #############
tabPanel("Monthly Budget",
conditionalPanel("output.any(ReactiveDf() == 'Savings') == TRUE ",
plotOutput("SavingsPlot")
)
########### THIS IS WHERE THE ERROR HAPPENS ##############
),
tabPanel("Budget to Date",
tableOutput("YearTable")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
## SAVE DATA
# Set Up Empty DF
df <- tibble("Name" = character(),
"Date" = character(),
"Category" = character(),
"Amount" = numeric(),
"Description" = character())
# DF is made reactive so we can add new lines
ReactiveDf <- reactiveVal(value = df)
# Add inputs as new data (lines)
observeEvent(input$Submit, {
if (input$Bucket == "" | input$Amount == 0 |
is.na(input$Amount)) {
return(NULL)
}
else {
# New lines are packaged together in a DF
new_lines <- data.frame(Name = as.character(input$Name),
Date = as.character(input$Date),
Category = input$Bucket,
Amount = as.character(input$Amount),
Description = as.character(input$Item))
# change df globally
df <<- rbind(df, new_lines)
# ensure amount is numeric
df <<- df %>%
mutate("Amount" = as.numeric(Amount))
# Update reactive values
ReactiveDf(df)
#clear out original inputs now that they are written to df
updateSelectInput(session, inputId = "Name", selected = "")
updateSelectInput(session, inputId = "Bucket", selected = "")
updateNumericInput(session, inputId = "Amount", value = 0)
updateTextInput(session, inputId = "Item", value = "")
}
})
## Preview Table
observeEvent(input$Submit, {
output$PreviewTable <-
function(){
ReactiveDf()[order(ReactiveDf()$Date, decreasing = TRUE),] %>%
kable("html") %>%
kable_material(c("striped", "hover")) %>%
kable_styling("striped", full_width = TRUE) %>%
column_spec(3, color = "black", background = ifelse(ReactiveDf()[3]=="Essential", "#87CEEB", ifelse(ReactiveDf()[3] == "Non-Essential", "#EBA487", ifelse(ReactiveDf()[3] == "Savings", "#87EBA4", ifelse(ReactiveDf()[3] == "Rent/Bills", "#A487EB", ifelse(ReactiveDf()[3] == "Trip", "#CEEB87", "#EB87CE")))))) %>%
column_spec(1, color = ifelse(ReactiveDf()[1] == "Ashley", "lightpink", "lightcyan"))
}
########## THIS IS THE LINE PLOT I AM TRYING TO RENDER ##########
output$SavingsPlot <- renderPlot({
savings <- ReactiveDf()[ReactiveDf()$Category == "Savings",]
savings <- savings[, -c(1,3,5)]
savings$Date <- as.Date(savings$Date)
savings$Amount <- as.numeric(savings$Amount)
savings <- as.xts(savings$Amount, order.by = as.Date(savings$Date))
weekly <- apply.weekly(savings,sum)
weekly_savings <- as.data.frame(weekly)
weekly_savings$names <- rownames(weekly_savings)
rownames(weekly_savings) <- NULL
colnames(weekly_savings) <- c("Amount", "Date")
Expected <- NULL
for(i in 1:dim(weekly_savings)[1]){
Expected[i] <- i * 625
}
weekly_savings$Expected <- Expected
ggplot(weekly_savings, aes(x = Date)) +
geom_line(aes(y = Expected), color = "red") +
geom_line(aes(y = Amount), color = "blue") +
ggtitle("House Downpayment Savings Over Time") +
ylab("Dollars") +
scale_x_date(date_minor_breaks = "2 day") +
scale_y_continuous(labels=scales::dollar_format())
})
})
########## THIS IS THE LINE PLOT I AM TRYING TO RENDER ##########
# Downloadable csv of selected dataset ----
output$Download <- downloadHandler(
filename = function() {
paste("A&J Budgeting ", Sys.Date(),".csv", sep = "")
},
content = function(file) {
write.csv(ReactiveDf(), file, row.names = FALSE)
}
)
# use if df new lines have errors
observeEvent(input$start_over, {
# change df globally
df <- tibble("Name" = character(),
"Date" = character(),
"Expense Category" = character(),
"Amount" = numeric(),
"Description" = character())
# Update reactive values to empty out df
ReactiveDf(df)
})
## MONTHLY TABLE
output$MonthlyTable <- renderTable({
ReactiveDf()
})
## YEAR TO DATE TABLE
output$YearTable <- renderTable({
ReactiveDf()
})
}
# Run the application
shinyApp(ui = ui, server = server)