Adding a sliderInput to a ggplot line chart in ShinyDashboard - r

Question

I've been struggling to add a functional slider input to my ggplot line chart for "number of observations", but I keep getting errors .. The code below works but the plot does not change ( I tried lots of stuff like adding a reactive function or adding input$obs inside ggplot but it still didn't work) .. I really appreciate your help ! Thanks
library(shiny)
library(shinydashboard)
library(readxl)
library(ggplot2)
library(dashboardthemes)
library(shinyWidgets)
library(dplyr)
df=read_excel("MASI.xlsx")
# Define UI for application that draws a histogram
ui <- dashboardPage(
dashboardHeader(title = "Finance Dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(
title = "Line chart", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot1", height = 250)
),
box(
title = "MASI", status = "primary", solidHeader = TRUE,
"The MASI index (Moroccan All Shares Index) is a stock index that tracks the performance of all
companies listed in the Casablanca Stock Exchange located at Casablanca."
),
box(
title = "Inputs", status = "primary", solidHeader = TRUE, collapsible = TRUE,
sliderInput("obs",
"Number of observations:",
min = 1,
max = length(df$MASI),
value = 50)
),
),
),
setBackgroundColor(
color = "white",
gradient = c("linear", "radial"),
direction = c("bottom", "top", "right", "left"),
shinydashboard = TRUE
)
)
server <- function(input, output) {
output$plot1 <- renderPlot({
ggplot(df,aes(x=Session, y=MASI)) + geom_line( color="darkblue", size=0.7) + theme_bw()
}, bg="transparent")
}
shinyApp(ui, server)
EDIT
Thank you for the kind answer #chemdork123.
I want to add a Date range in addition to the sliderInput. Here's what I did:
library(shiny)
library(shinydashboard)
library(readxl)
library(ggplot2)
library(dashboardthemes)
library(shinyWidgets)
library(dplyr)
df=read_excel("MASI.xlsx")
# Define UI for application that draws a histogram
box_height = "20em"
plot_height = "16em"
ui <- dashboardPage(
dashboardHeader(title = "Finance Dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(
title = "Line chart", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot1", height = 250)
),
box(
title = "MASI", status = "primary", solidHeader = TRUE,
"The MASI index (Moroccan All Shares Index) is a stock index that tracks the performance of all
companies listed in the Casablanca Stock Exchange located at Casablanca."
),
box(
title = "Inputs", status = "primary", solidHeader = TRUE, collapsible = TRUE,
sliderInput("obs",
"Number of observations:",
min = 1,
max = length(df$MASI),
value = 50),
dateRangeInput("date", strong("Date range"),
start = "2015-01-02", end = "2020-07-17",
min = "2015-01-02", max = "2020-07-17")
),
box(
title = "Line chart", status = "success", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot2", height = 250)
),
box(
title = "Return", status = "success", solidHeader = TRUE,
"The relative difference of the MASI index"
),
box(
title = "Inputs", status = "success", solidHeader = TRUE, collapsible = TRUE,
sliderInput("obs",
"Number of observations:",
min = 1,
max = length(df$MASI),
value = 50)
),
),
),
setBackgroundColor(
color = "white",
gradient = c("linear", "radial"),
direction = c("bottom", "top", "right", "left"),
shinydashboard = TRUE
)
)
server <- function(input, output) {
reactive_data <- reactive({
set.seed(8675309) # for some consistent sampling
df <- df[sample(x=1:nrow(df), size = input$obs),]
return(df)
req(input$date)
validate(need(!is.na(input$date[1]) & !is.na(input$date[2]), "Error: Please provide both a start and an end date."))
validate(need(input$date[1] < input$date[2], "Error: Start date should be earlier than end date."))
df %>%
filter(
date > as.POSIXct(input$date[1]) & date < as.POSIXct(input$date[2]
))
})
output$plot1 <- renderPlot({
ggplot(reactive_data(),aes(x=Session, y=MASI)) + geom_line(color="darkblue", size=0.7) + theme_bw()
}, bg="transparent")
output$plot2 <- renderPlot({
ggplot(df,aes(x=Session, y=Return)) + geom_line( color="darkblue", size=0.7) + theme_bw()
}, bg="transparent")
}
shinyApp(ui, server)
Here is a link for the Dataset
Capture

Answer 1

OP. Without your data, it's difficult to give you a clear answer to your particular question, but I can show you how the input$obs slider input control can be used (or any other one for that matter) to filter and provide data for your ggplot() function to display.
Here's a working app that gives you two controls to adjust what data is displayed from the mtcars built-in dataset. The sliderInput() control determines how many rows are sampled from the total mtcars dataset. The selectInput() control allows you to select one or all of the values for mtcars$carb to display in the chart based on the sampled dataset.
You will see the general approach on how to use both inputs reactively is to create a reactive function (called sample_cars()) that is called inside of the renderPlot() function. The reactive function sample_cars() returns a data frame that is used in the ggplot() call.
library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(tidyr)
ui <- dashboardPage(
dashboardHeader(title = "Example App"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(
title = "Line chart", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot1", height = 250)),
box(
title = "Inputs", status = "primary", solidHeader = TRUE, collapsible = TRUE,
sliderInput("obs", "Number of observations:",
min = 1, step = 1, max = nrow(mtcars), value = nrow(mtcars)),
selectInput("carbs", "Select carb to show",
choices = c('All', unique(mtcars$carb))
)
),
)
)
)
server <- function(input, output) {
sample_cars <- reactive({
set.seed(8675309) # for some consistent sampling
df <- mtcars[sample(x=1:nrow(mtcars), size = input$obs),]
if(input$carbs != "All")
df <- df %>% dplyr::filter(carb == input$carbs)
return(df)
})
output$plot1 <- renderPlot({
ggplot(sample_cars(), aes(mpg, disp)) + geom_point() +
labs(title=paste('You selected',input$obs, 'cars\n and to show',input$carbs, 'values of carb!'))
}, bg="transparent")
}
shinyApp(ui, server)