Related
I am building a shiny budgeting shiny application that prompts the user to enter data such as what type of expense was spent, the amount, and a description. I would like to display a line plot in the second pannel of the application labeled "Monthly Budget" ONLY when the user has entered at least one data entry where the category is "Savings". I have tried experimenting with things such as hiding/displaying the plot whenever the condition is met, but it seems that I always get a NaN error message with this approach. Thus, I am experimenting with conditionalPanel() in hopes of accomplishing this task. I've noticed similar posts to this one, however this is the first case that I have found where conditionalPanel() deals with data that the user inputs as opposed to a given dataset. In the code below I get the following error message: "Error in: Invalid input: date_trans works with objects of class Date only".
Here is the code:
# 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)
We can use a condition like nrow(filter(ReactiveDf(), Category == 'Savings')) > 0 as if ReactiveDf is a normal df. Also, when converting the xts object to a df the Date column was coerced to character.
app:
# Libraries
library(shiny)
library(tidyverse)
library(shinycssloaders)
library(colortools)
library(shinythemes)
library(DT)
library(tidyverse)
library(kableExtra)
library(formattable)
library(xts)
library(lubridate)
# 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")
)
)
)
),
tabPanel("Monthly Budget",
plotOutput("SavingsPlot")
),
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 ##########
if (nrow(filter(ReactiveDf(), Category == 'Savings')) > 0) {
output$SavingsPlot <- renderPlot({
savings <- filter(ReactiveDf(), Category == 'Savings')
savings$Date <- as.Date(savings$Date, format = "%Y-%m-%d")
savings$Amount <- as.numeric(savings$Amount)
savings <- as.xts(savings$Amount, order.by = 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 = ymd(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)
I am currently having issues with my R.Shiny app which I have designed. The UI has a drop down menu which selects a variable "returnvar", one of the columns in my dataframe source_file. However, upon running the code below I receive an error message stating:
Warning: Unknown or uninitialised column: 'returnvar'.
Warning: Error in : geom_line requires the following missing aesthetics: y
Does anyone know how I can reference an input into my source file? (Something to fix the error from the line source_file_filtered$returnvar) Would greatly appreciate all the help I can get for this, thanks!
App.R
# Defining UI
ui <- fluidPage(theme = shinytheme("darkly"),
navbarPage(
"App", #Title of app
tabPanel("Weekly Cumulative Returns",
sidebarPanel(
tags$h3("Input:"),
dateRangeInput("daterange", "Date range",
start = "2016-01-01",
end = "2021-04-02",
min = "2016-01-01",
max = "2021-04-02",
format = "yyyy/mm/dd",
separator = "to"),
selectInput("returnvar", "Index",
choices= names(source_file[2:(length(source_file)-1)])),
), #sidebarpanel
mainPanel(
# Output: Correlation Plot ----
plotOutput(outputId = "plot2"),
), #mainPanel
) #tabpanel
) #navbarPage
) #fluidPage
# Defining Server
server <- function(input, output) {
#plot for Weekly Cumulative Returns tab
output$plot2 <- renderPlot({
returncolumn(returnvar = input$returnvar,
daterange = input$daterange)
})
}
# Create Shiny Object
shinyApp(ui = ui, server = server)
Global.R
#choose source file to work with
file_name = file.choose()
source_file = read_csv(file_name)
source_file$Date = as.Date(source_file$Date)
#defining returncolumn as a function to return of selected variable over the selected date range in shiny
returncolumn = function(returnvar, daterange)
{
source_file_filtered <- source_file %>%
filter(Date >= daterange[1] & Date <= daterange[2])
g = ggplot(data = source_file_filtered, mapping = aes(x=Date, y=source_file_filtered$returnvar)) + geom_line(color="blue")
print(g)
}
Without the data its hard to test, but changing source_file_filtered$returnvar to source_file_filtered[[returnvar]] should make it work.
returncolumn = function(returnvar, daterange)
{
source_file_filtered <- source_file %>%
filter(Date >= daterange[1] & Date <= daterange[2])
g = ggplot(data = source_file_filtered,
mapping = aes(x = Date,
y = source_file_filtered[[returnvar]])) +
geom_line(color="blue")
print(g)
}
I am trying to build a shiny app to show COVID-19 cases for the 10 worst affected countries with refreshes daily from the ECDC website. I want to be able to limit cases and deaths using slider inputs, and select date periods with date inputs, (all already added).
The code is below, but when I run the app I get a blank plot, the axis are displaying correctly but I can't get the points to appear. This should be able to run on any computer as the code just downloads the data set from the ECDC page.
Any solutions?
library(shiny)
library(readxl)
library(dplyr)
library(httr)
library(ggplot2)
library(plotly)
url <- paste("https://www.ecdc.europa.eu/sites/default/files/documents/COVID-19-geographic-disbtribution-worldwide-",format(Sys.time(), "%Y-%m-%d"), ".xlsx", sep = "")
GET(url, authenticate(":", ":", type="ntlm"), write_disk(tf <- tempfile(fileext = ".xlsx")))
data <- read_excel(tf)
include<-c("United_Kingdom","Italy","France","China",
"United_States_of_America","Spain","Germany",
"Iran","South_Korea","Switzerland")
ui <- fluidPage(
titlePanel("COVID-19 Daily Confirmed Cases & Deaths"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("Country", "Select Country", selected = NULL, inline = FALSE,
width = NULL),
dateRangeInput("DateRep","Select Date Range", start = "2019-12-31", end = NULL),
sliderInput("Cases","Select Cases Range", min = 1, max = 20000, value = NULL),
sliderInput("Deaths", "Select Death Range", min = 1, max = 10000, value = 100),
submitButton("Refresh")
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
include<-input$Country
plot_data<-filter(data, `Countries and territories` %in% include)%>%
filter(between(input$Cases))
plot_data%>% ggplot(aes(x=input$DateRep, y=input$Cases, size =input$Deaths, color = input$Country)) +
geom_point(alpha=0.5) +
theme_light()
})
}
shinyApp(ui = ui, server = server)
I think it would be better to define and filter the data you want to plot in a reactive expression outside of renderPlot. It will allow you to re-use these data more easily and it is easier (from my point of view) to use ggplot without inputs directly in it.
I include as.Date(DateRep) >= input$DateRep[1] & as.Date(DateRep) <= input$DateRep[2]) in filter to select the interval between the two chosen dates. Since the column DateRep has a POSIXct format, you need to use as.Date on it to convert it to the format dateRangeInput produces.
Here's the result:
library(shiny)
library(readxl)
library(dplyr)
library(httr)
library(ggplot2)
library(plotly)
url <- paste("https://www.ecdc.europa.eu/sites/default/files/documents/COVID-19-geographic-disbtribution-worldwide-",format(Sys.time(), "%Y-%m-%d"), ".xlsx", sep = "")
GET(url, authenticate(":", ":", type="ntlm"), write_disk(tf <- tempfile(fileext = ".xlsx")))
data <- read_excel(tf)
include<-c("United_Kingdom","Italy","France","China",
"United_States_of_America","Spain","Germany",
"Iran","South_Korea","Switzerland")
ui <- fluidPage(
titlePanel("COVID-19 Daily Confirmed Cases & Deaths"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("Country", "Select Country", choices = include, selected = "France"),
dateRangeInput("DateRep","Select Date Range", start = "2019-12-31", end = NULL),
sliderInput("Cases","Select Cases Range", min = 1, max = 20000, value = NULL),
sliderInput("Deaths", "Select Death Range", min = 1, max = 10000, value = 100),
submitButton("Refresh")
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
plot_data <- reactive({
filter(data, `Countries and territories` %in% input$Country
& as.Date(DateRep) >= input$DateRep[1]
& as.Date(DateRep) <= input$DateRep[2]) %>%
filter(between(Cases, 1, input$Cases))
})
output$plot <- renderPlot({
plot_data() %>%
ggplot(aes(x = as.Date(DateRep), y= Cases, size = Deaths, color = `Countries and territories`)) +
geom_point(alpha=0.5) +
theme_light()
})
}
shinyApp(ui = ui, server = server)
I started to fix this, but ran out of time... so here's what I did, maybe you can complete it...
library(shiny)
library(readxl)
library(dplyr)
library(httr)
library(ggplot2)
library(plotly)
url <- paste("https://www.ecdc.europa.eu/sites/default/files/documents/COVID-19-geographic-disbtribution-worldwide-",format(Sys.time(), "%Y-%m-%d"), ".xlsx", sep = "")
GET(url, authenticate(":", ":", type="ntlm"), write_disk(tf <- tempfile(fileext = ".xlsx")))
data <- read_excel(tf)
ui <- fluidPage(
titlePanel("COVID-19 Daily Confirmed Cases & Deaths"),
sidebarLayout(
sidebarPanel(
uiOutput("country_checkbox"),
dateRangeInput("DateRep","Select Date Range", start = "2019-12-31", end = NULL),
sliderInput("Cases","Select Cases Range", min = 1, max = 20000, value = NULL),
sliderInput("Deaths", "Select Death Range", min = 1, max = 10000, value = 100)
#submitButton("Refresh")
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
output$country_checkbox <- renderUI({
countries <- unique(data.frame(data)[, "Countries.and.territories"])
checkboxGroupInput("country", "Select Country",
choices = countries,
selected = NULL, inline = FALSE,
width = NULL)
})
output$plot <- renderPlot({
include<-input$country
plot_data<-filter(data, `Countries and territories` %in% include)%>%
filter(between(Cases, 1, input$Cases))
plot_data%>% ggplot(aes(x=DateRep, y=Cases, size =Deaths, color = `Countries and territories`)) +
geom_point(alpha=0.5) +
theme_light()
})
}
shinyApp(ui = ui, server = server)
I'm making a shiny app, which takes "dateRangeInput" as input and plots plot for data within that "date range". Also, I'm using conditionalPanel to not show the plot when the dates from input are not available in data and show text to the user to select dates only available in data.
The problem is, the conditional panel is not working and not showing anyting at all irrespective of date inputs. (setting the limits to max and min dates available in data to max & min of dateRangeInput is not an option.).
link to data: https://drive.google.com/open?id=17ipXwRimovR_QBYT2O1kxSGTzem_bN-1
Here's what I've done and tried:
# loading the data and making the interpretation of first column proper
wait_data <- transform(read.csv("dummy wait times data of 12 departments.csv", header = TRUE),
Date = as.Date(Date, "%d-%m-%y"))
# sorting the data according to dates
wait_data <- data.frame(with(wait_data, wait_data[order(Date),]),
row.names = NULL)
library(shiny)
library(plotly)
ui_function <- fluidPage(
sidebarLayout(
sidebarPanel(width = 3,
dateRangeInput(inputId = 'date_range',
label = paste('Choose range from January 1, 2017 to December 31, 2018:'),
start = as.Date("2017-01-01"), end = as.Date("2017-05-31"),
min = as.Date("2017-01-01"), max = Sys.Date(),
separator = " to ", format = "MM-dd, yyyy",
startview = 'year', weekstart = 1),
selectInput(inputId = "department_input",
label = "Choose a Department to see wait times:",
choices = c("General Checkup"="General Checkup",
"Emergency"="Emergency",
"Cardiology"="Cardiology",
"Gynaecology"="Gynaecology",
"Maternity"="Maternity",
"Neurology"="Neurology",
"Oncology"="Oncology",
"Orthopedics"="Orthopedics",
"Otalaryntology"="Otalaryntology",
"Psychiatry"="Psychiatry",
"Radiology"="Radiology",
"Urology"="Urology"),
multiple = TRUE,
selected = c("Cardiology","Gynaecology"))
),
mainPanel(width = 9,
uiOutput("plots_or_text")
# uiOutput("resource_or_moretext")
# conditionalPanel(
# condition = "output.dates_matches",
# plotlyOutput("wait_times_plot"),
# dataTableOutput("resource_counts")
# ),
# conditionalPanel(
# condition = "output.dates_matches",
# htmlOutput("select_available_dates")
# )
)
)
)
server_function <- function(input, output) {
min_date_in_data <- reactive({min(wait_data[,"Date"])})
max_date_in_data <- reactive({max(wait_data[,"Date"])})
# output$dates_matches <- reactive ({
# if (input$date_range[2] > max_date_in_data() | input$date_range[1] < min_date_in_data()){return(FALSE)}
# else if (input$date_range[2] <= max_date_in_data() | input$date_range[1] >= min_date_in_data()){return(TRUE)}
# })
#
#
# # output$select_good_dates <- renderText({dates_matches()})
# output$select_available_dates <- renderText({paste("select dates available in data")})
# now filter based on date range inputs
date_range_data <- reactive({
wait_data[(wait_data[,"Date"] > input$date_range[1] & wait_data[,"Date"] < input$date_range[2]), ]
})
# now take the data returned from above aggregation and filter it for department selection.
filtered_department_data <- reactive({date_range_data()[date_range_data()[,"Department"] %in% input$department_input, ]})
# # plot it now
# output$wait_times_plot <- renderPlotly({
# plot_ly(data = filtered_department_data(),
# x = ~Date, y=~average_wait_time_min,
# split = ~Department,
# type = "scatter", mode="lines+markers")
# })
output$plots_or_text <- renderUI({
if (input$date_range[2] <= max_date_in_data() | input$date_range[1] >= min_date_in_data()){
renderPlotly({plot_ly(data = filtered_department_data(),
x = ~Date, y=~average_wait_time_min, split = ~Department,
type = "scatter", mode="lines+markers")
})
}
else if (input$date_range[2] > max_date_in_data() | input$date_range[1] < min_date_in_data()){
renderText({paste("select dates available in data")})
}
})
}
shinyApp(ui_function, server_function)
That code returns
object of type 'closure' is not subsettable in my mainPanel.
EDIT 1:
changes in server:
make_plot <- reactive({
# I've copied the below condition from my if
validate(
need(input$date_range[2] <= max_date_in_data() | input$date_range[1] >= min_date_in_data(),
message = "Seems like you've selected dates out of range. Please change your filters."))
plot_ly(data = filtered_department_data(),
x = ~Date, y=~average_wait_time_min, split = ~Department,
type = "scatter", mode="lines+markers")
# ggplot(data = filtered_department_data(),
# aes(x = Date, y=average_wait_time_min, split = Department)) + geom_line() + geom_point()
})
output$plot_or_error <- renderPlotly(make_plot())
# output$plot_or_error <- renderPlot(make_plot())
I just can't solve this. both libraries' plots show up irrespective of inputs in dateRangeInput. if the data for the selected date range is not available, there's simply a blank plot, no error messages shows up in that case.
As long as all you want to do is print an informative message when the plot can't be made for some reason, validate + need are your friends. For example:
library(shiny)
library(dplyr)
library(ggplot2)
ui <- basicPage(
selectInput(
inputId = "sp",
label = "Select species",
choices = unique(iris$Species),
#selected = unique(iris$Species),
multiple = TRUE
),
tags$br(),
plotOutput("plot_or_error")
)
server <- function(input, output) {
make_plot <- reactive({
df <- filter(iris, Species %in% input$sp)
validate(need(nrow(df) > 0,
message = "Seems like after filtering there are 0 rows. Please change your filters."))
ggplot(df, aes(x=Species, y=Sepal.Length)) + geom_boxplot()
})
output$plot_or_error <- renderPlot({
make_plot()
})
}
shinyApp(ui, server)
EDIT: r user's code and data.
# loading the data and making the interpretation of first column proper
wait_data <-
transform(
read.csv("dummy wait times data of 12 departments.csv", header = TRUE),
Date = as.Date(Date, "%d-%m-%y")
)
# sorting the data according to dates
wait_data <- data.frame(with(wait_data, wait_data[order(Date), ]),row.names = NULL)
library(shiny)
library(dplyr) # not necessary, code included with dplyr or base R
library(plotly)
ui_function <- fluidPage(
sidebarLayout(
sidebarPanel(width = 3,
dateRangeInput(inputId = 'date_range',
label = paste('Choose range from January 1, 2017 to December 31, 2018:'),
start = as.Date("2017-01-01"), end = as.Date("2017-05-31"),
min = as.Date("2017-01-01"), max = Sys.Date(),
separator = " to ", format = "MM-dd, yyyy",
startview = 'year', weekstart = 1),
selectInput(inputId = "department_input",
label = "Choose a Department to see wait times:",
choices = c("General Checkup"="General Checkup",
"Emergency"="Emergency",
"Cardiology"="Cardiology",
"Gynaecology"="Gynaecology",
"Maternity"="Maternity",
"Neurology"="Neurology",
"Oncology"="Oncology",
"Orthopedics"="Orthopedics",
"Otalaryntology"="Otalaryntology",
"Psychiatry"="Psychiatry",
"Radiology"="Radiology",
"Urology"="Urology"),
multiple = TRUE,
selected = c("Cardiology","Gynaecology"))
),
mainPanel(width = 9,
plotlyOutput("plot_or_error")
)
)
)
server_function <- function(input, output) {
make_df <- reactive({
wait_data %>%
filter(Department %in% input$department_input) %>%
filter(Date >= input$date_range[1], Date <= input$date_range[2])
})
# no dplyr
make_df_base <- reactive({
fd <- wait_data[wait_data$Department %in% input$department_input, ]
fd <- fd[fd$Date > input$date_range[1] & fd$Date < input$date_range[2], ]
fd
})
make_plot <- reactive({
validate(
need(nrow(make_df_base()) > 0, # can be make_df()
message = "Seems like you've selected dates out of range. Please change your filters."))
plot_ly(data = make_df_base(), # can be make_df()
x = ~Date, y=~average_wait_time_min, split = ~Department,
type = "scatter", mode="lines+markers")
})
output$plot_or_error <- renderPlotly({make_plot()})
}
shinyApp(ui_function, server_function)
EDIT 2: check with the dates instead of data frame
# loading the data and making the interpretation of first column proper
wait_data <-
transform(
read.csv("dummy wait times data of 12 departments.csv", header = TRUE),
Date = as.Date(Date, "%d-%m-%y")
)
# sorting the data according to dates
wait_data <- data.frame(with(wait_data, wait_data[order(Date), ]),row.names = NULL)
library(shiny)
library(dplyr)
library(plotly)
ui_function <- fluidPage(
sidebarLayout(
sidebarPanel(width = 3,
dateRangeInput(inputId = 'date_range',
label = paste('Choose range from January 1, 2017 to December 31, 2018:'),
start = as.Date("2017-01-01"), end = as.Date("2017-05-31"),
min = as.Date("2017-01-01"), max = Sys.Date(),
separator = " to ", format = "MM-dd, yyyy",
startview = 'year', weekstart = 1),
selectInput(inputId = "department_input",
label = "Choose a Department to see wait times:",
choices = c("General Checkup"="General Checkup",
"Emergency"="Emergency",
"Cardiology"="Cardiology",
"Gynaecology"="Gynaecology",
"Maternity"="Maternity",
"Neurology"="Neurology",
"Oncology"="Oncology",
"Orthopedics"="Orthopedics",
"Otalaryntology"="Otalaryntology",
"Psychiatry"="Psychiatry",
"Radiology"="Radiology",
"Urology"="Urology"),
multiple = TRUE,
selected = c("Cardiology","Gynaecology"))
),
mainPanel(width = 9,
plotlyOutput("plot_or_error")
)
)
)
server_function <- function(input, output) {
# these don't need to be reactive unless you have the user load or switch datasets
min_date_in_data <- reactive({ min(wait_data[,"Date"], na.rm = TRUE) })
max_date_in_data <- reactive({ max(wait_data[,"Date"], na.rm = TRUE) })
make_df <- reactive({
se <- input$date_range
validate(need(se[1] >= min_date_in_data(), message = "The first date is outside the range of the data."))
validate(need(se[2] <= max_date_in_data(), message = "The second date is outside the range of the data."))
validate(need(se[1] < se[2], message = "The second date needs to be after the first date."))
validate(need(input$department_input != "", message = "Please select a department."))
wait_data %>%
filter(Department %in% input$department_input) %>%
filter(Date >= input$date_range[1], Date <= input$date_range[2])
})
# no dplyr
make_df_base <- reactive({
fd <- wait_data[wait_data$Department %in% input$department_input, ]
fd <- fd[fd$Date > input$date_range[1] & fd$Date < input$date_range[2], ]
fd
})
make_plot <- reactive({
plot_ly(data = make_df(),
x = ~Date, y=~average_wait_time_min, split = ~Department,
type = "scatter", mode="lines+markers")
})
output$plot_or_error <- renderPlotly({make_plot()})
}
shinyApp(ui_function, server_function)
I'm working on a dashbord with Shiny and want to compute new variables based on the selected Variabels by selectInput.
Comparable to this in normal R-Code:
library(dplyr)
new_df <- old_df %>% mutate(new_1 = old_var1 + old_var2)
I'm able to compute new values with the sliderInput, but this are only single values. I want to compute a hole new variable with all the oppertunities of displaying the new variable in Tables and graphics.
Please try the followring syntax (the data is online avalible).
As you mentioned, all Inputs are working as they should.
library(shiny)
library(readr)
library(ggplot2)
library(stringr)
library(dplyr)
library(DT)
library(tools)
load(url("http://s3.amazonaws.com/assets.datacamp.com/production/course_4850/datasets/movies.Rdata"))
ui <- fluidPage(
sidebarLayout(
# Inputs
sidebarPanel(
h3("Plotting"), # Third level header: Plotting
# Select variable for y-axis
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("IMDB rating" = "imdb_rating",
"IMDB number of votes" = "imdb_num_votes",
"Critics Score" = "critics_score",
"Audience Score" = "audience_score",
"Runtime" = "runtime"),
selected = "audience_score"),
# Select variable for x-axis
selectInput(inputId = "x",
label = "X-axis:",
choices = c("IMDB rating" = "imdb_rating",
"IMDB number of votes" = "imdb_num_votes",
"Critics Score" = "critics_score",
"Audience Score" = "audience_score",
"Runtime" = "runtime"),
selected = "critics_score"),
# Select variable for color
selectInput(inputId = "z",
label = "Color by:",
choices = c("Title Type" = "title_type",
"Genre" = "genre",
"MPAA Rating" = "mpaa_rating",
"Critics Rating" = "critics_rating",
"Audience Rating" = "audience_rating"),
selected = "mpaa_rating"),
hr(),
# Set alpha level
sliderInput(inputId = "alpha",
label = "Alpha:",
min = 0, max = 1,
value = 0.5),
# Set point size
sliderInput(inputId = "beta",
label = "Beta:",
min = 0, max = 5,
value = 2)
),
# Output:
mainPanel(plotOutput(outputId = "scatterplot"),
textOutput(outputId = "description"),
DT::dataTableOutput("moviestable"))
)
)
server <- function(input, output, session) {
output$scatterplot <- renderPlot({
ggplot(data = movies, aes_string(x = input$x, y = input$y,
color = input$z)) +
geom_point(alpha = input$alpha, size = input$beta) +
labs(x = toTitleCase(str_replace_all(input$x, "_", " ")),
y = toTitleCase(str_replace_all(input$y, "_", " ")),
color = toTitleCase(str_replace_all(input$z, "_", " ")))
})
vals <- reactiveValues()
observe({
vals$x <- input$alpha
vals$y <- input$beta
vals$sum <- vals$x + vals$y
})
output$description <- renderText({
paste0("Alpha: ",input$alpha, " Beta:", input$beta," and the sum of alpha and beta:",vals$sum, ".")
})
output$moviestable <- DT::renderDataTable({
DT::datatable(data = movies,
options = list(pageLength = 10),
rownames = FALSE)
})
}
shinyApp(ui = ui, server = server)
I tried different ways to solve this problem:
1st try:
vals2 <- reactiveValues()
observe({
vals2$x <- input$y
vals2$y <- input$x
vals2$sum <- vals2$x + vals2$y
})
output$description2 <- renderText({
paste0("Input y: ",input$y, " Input x:", input$x," and the sum of both variables is:",vals2$sum, ".")
})
Warning: Error in +: non-numeric argument to binary operator
Stack trace (innermost first):
56: observerFunc [C:/Users/XXXXXX/Desktop/app.R#110]
1: runApp
ERROR: [on_request_read] connection reset by peer
2nd try:
output$try2 <- renderUI({
movies_2 <- movies %>% mutate(new_1 = input$y + input$x)
})
output$moviestable2 <- DT::renderDataTable({
DT::datatable(data = movies_2,
options = list(pageLength = 10),
rownames = FALSE)
})
Warning: Error in inherits: object 'movies_2' not found
I've no idea where I what I can try next...
I'm very happy for every kind of help!
You should make movies_2 in a reactive. Your output$try2 won't work because its expecting UI objects.
To match the call you make on the UI side I've renamed back to moviestable and have changed input$x + input$y to paste0(input$y, input$x) since they are both character.
movies_2 <- reactive({
movies %>% mutate(new_1 := movies[[input$x]] + movies[[input$y]])
})
output$moviestable <- DT::renderDataTable({
DT::datatable(data = movies_2(),
options = list(pageLength = 10),
rownames = FALSE)
})