Dynamic Plots Based on One or More Dropdown Values 2 - shiny

This question is related to one I asked here: Dynamic Plots Based on One or More Dropdown Values. Although I got an answer from Mr.Rlover, the resulting plots do not look the same. If I choose two or more plots, it seems that the data is being added on and this is reflected exactly in the plots. I wonder how one would separate data based on different species.
one species selected
two or more species selected
Below was my original question:
I am trying to make multiple dynamic plots (one does not know how many plots will output) based on one or more selected dropdown value(s) (species in this case).
I did succeed making plots based on the dropdown. For instance, two plots are displayed if a user selected two values/species from the dropdown list, one plot is displayed if one value/species is selected.
Although the number of plots match the number of dropdown values, the plots show a duplicate if two or more dropdown values/species are selected (it only works if exactly one value is selected). Any advice would be of great help.
The below code uses the iris dataset in R.
library(shiny)
library(shinyWidgets)
library(ggplot2)
library(tidyverse)
library(shinydashboard)
species = c("setosa", "versicolor", "virginica")
ui <- dashboardPage(
dashboardHeader(title = "title"),
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("General Overview", tabName = "tab1", icon = icon("dashboard"))
)
),
body <- dashboardBody(
tabItems(
tabItem(
tabName = "tab1",
uiOutput("species_dropdown"),
# DT::dataTableOutput("table1"),
uiOutput("plots")
)
)
)
)
server <- function(input, output) {
output$species_dropdown <- renderUI({
pickerInput(
"var1",
"Species:",
choices = species,
options = pickerOptions(
actionsBox = T,
header = "Close",
liveSearch = T
),
multiple = T
)
})
filtered_data <- reactive({
iris %>%
filter(Species %in% input$var1) # I think is causing the problem
})
output$table1 <- DT::renderDataTable({
req(input$var1)
filtered_data()
})
# Insert the right number of plot output objects into the web page
output$plots <- renderUI({
req(input$var1)
plot_output_list <- lapply(1:length(input$var1), function(i) {
plotname <- paste("plot", i, sep="")
plotOutput(plotname, height = 280, width = 250)
})
do.call(tagList, plot_output_list)
})
for (i in 1:length(species)) {
local({
my_i <- i #crucial
plotname <- paste("plot", my_i, sep="") # use my_i instead of i
output[[plotname]] <- renderPlot({
ggplot(filtered_data(), aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
labs(title = paste(input$var1[my_i], sep = ""), x = "Sepal Length", y = "Sepal Width") # title needs input$var1 indexed as paste will return a list otherwise, in which case only a first element gets used for the title hence all titles are identical
})
})
}
}
shinyApp(ui, server)

By doing iris %>% filter(Species %in% input$var1) only one dataset was generated. We need one per number of Species.
Instead we create a list with each corresponding plot:
filtered_data <- reactive({
map(input$var1, ~
iris %>%
filter(Species == .x))
})
and subset it with filtered_data()[[index]]
Full app
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tidyverse)
species <- c("setosa", "versicolor", "virginica")
ui <- dashboardPage(
dashboardHeader(title = "title"),
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("General Overview", tabName = "tab1", icon = icon("dashboard"))
)
),
body <- dashboardBody(
tabItems(
tabItem(
tabName = "tab1",
uiOutput("species_dropdown"),
uiOutput("plots")
)
)
)
)
server <- function(input, output) {
output$species_dropdown <- renderUI({
pickerInput(
"var1",
"Species:",
choices = species,
options = pickerOptions(
actionsBox = T,
header = "Close",
liveSearch = T
),
multiple = T
)
})
filtered_data <- reactive({
map(input$var1, ~
iris %>%
filter(Species == .x)) %>%
set_names(input$var1)
})
#Insert the right number of plot output objects into the web page
output$plots <- renderUI({
req(input$var1)
plot_output_list <- lapply(input$var1, function(i) {
plotname <- paste("plot_", i, sep = "")
plotOutput(plotname, height = 280, width = 250)
})
do.call(tagList, plot_output_list)
})
observeEvent(filtered_data(), {
iwalk(filtered_data(), ~{
output[[paste0("plot_",.y)]] <<- renderPlot({
ggplot(.x, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
labs(title = .y, x = "Sepal Length", y = "Sepal Width")
})
})
})
}
shinyApp(ui, server)

Using iris %>% filter(Species %in% input$var1[my_i]) directly inside local({}) was the key instead of using:
filtered_data <- reactive({
iris %>%
filter(Species %in% input$var1)
})
for (i in 1:length(species)) {
local({
my_i <- i
plotname <- paste("plot", my_i, sep="")
output[[plotname]] <- renderPlot({
ggplot(iris %>% filter(Species %in% input$var1[my_i]), aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
labs(title = paste(input$var1[my_i], sep = ""), x = "Sepal Length", y = "Sepal Width")
})
})
}

Related

Remove unwanted white space when rendering leaflet or plot in Shiny

I want the user of my Shiny app to be able to choose between two types of plots by clicking on radiobuttons in the Events panel. The code I have written works, but the page leaves a huge white space when going from "Map" to "Plot". Is there any way to get rid of the white space and position the plot at the very top?
# Load R packages
library(shiny)
library(shinythemes)
library(tidyverse)
library(leaflet)
set.seed(123)
year <- 2001:2020
event <- sample(1:100, size = 20, replace = TRUE)
dat <- as.data.frame(cbind(year, event))
# Define UI
ui <- fluidPage(
shinyjs::useShinyjs(),
theme = shinytheme("journal"),
navbarPage(
"Title",
tabPanel("About",
),
tabPanel("Events",
fluidPage(
titlePanel("Title"),
sliderInput("range", label = "Move slider to select time period", min(2001), max(2020),
value = range(2001:2002), step = 1, sep = "", width = "65%"),
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type", choices = c("Map" = "m", "Chart" = "l"))),
mainPanel(
leafletOutput("map"),
plotOutput("plot"))
)
)
)
)
)
# Define server function
server <- function(input, output, session) {
observeEvent(input$plotType, {
if(input$plotType == "l"){
shinyjs::disable("range")
}else{
shinyjs::enable("range")
}
})
output$plot <- renderPlot({
if (input$plotType == "l") {
ggplot(dat, aes(year, event)) +
geom_line() +
labs(x = "Year", y = "Events") +
theme_bw()
}
})
output$map <- renderLeaflet({
if ( input$plotType == "m") {
leaflet(dat) %>% addTiles() %>%
fitBounds(~min(11), ~min(54), ~max(67), ~max(24))
}
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)
There is a big space because the map html object still exists, but is empty. To avoid this, I created and observeEvent that hides or show the map output depending on input value. I did the same thing with the plot, in cas you need to add others elements below it.
Please note that there are others solutions (conditionalPanel for example), I am just giving you the one I think is the simpliest here.
# Load R packages
library(shiny)
library(shinythemes)
library(tidyverse)
library(leaflet)
set.seed(123)
year <- 2001:2020
event <- sample(1:100, size = 20, replace = TRUE)
dat <- as.data.frame(cbind(year, event))
# Define UI
ui <- fluidPage(
shinyjs::useShinyjs(),
theme = shinytheme("journal"),
navbarPage(
"Title",
tabPanel("About",
),
tabPanel("Events",
fluidPage(
titlePanel("Title"),
sliderInput("range", label = "Move slider to select time period", min(2001), max(2020),
value = range(2001:2002), step = 1, sep = "", width = "65%"),
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type", choices = c("Map" = "m", "Chart" = "l"))),
mainPanel(
leafletOutput("map"),
plotOutput("plot"))
)
)
)
)
)
# Define server function
server <- function(input, output, session) {
# hide or show map and plot
observeEvent(input$plotType, {
if(input$plotType == "l"){
shinyjs::disable("range")
shinyjs::hide("map")
shinyjs::show("plot")
}
if(input$plotType == "m"){
shinyjs::enable("range")
shinyjs::show("map")
shinyjs::hide("plot")
}
})
output$plot <- renderPlot({
req(input$plotType == "l") # good practice to use req instead of if
ggplot(dat, aes(year, event)) +
geom_line() +
labs(x = "Year", y = "Events") +
theme_bw()
})
output$map <- renderLeaflet({
req(input$plotType == "m")
leaflet(dat) %>% addTiles() %>%
fitBounds(~min(11), ~min(54), ~max(67), ~max(24))
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)

Add Dynamic Plot Subtitles in Rshiny

What I achieved so far: I have a fully reproducible shiny app (using iris dataset) which makes dynamic plots (one does not know how many plots will output) based on one or more selected dropdown value(s) (Species in this case).
My question: I'd like to add a dynamic subtitle from a column called new. To elaborate, each Species has exactly two unique values (e.g., a and b for Species = setosa). Is there a way to add these unique values so that it could be integrated into the dynamic plots ?
What I tried:
df() %>% select(new) %>% distinct() %>% pull()
However, this does not produce the output I want.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tidyverse)
species <- c("setosa", "versicolor", "virginica")
iris %>% filter(Species == "setosa")
vals1 <- rep(c("a", "b"), 25)
vals2 <- rep(c("c", "d"), 25)
vals3 <- rep(c("e", "f"), 25)
vals <- c(vals1, vals2, vals3)
iris <- iris %>%
mutate(new = vals)
ui <- dashboardPage(
dashboardHeader(title = "title"),
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("General Overview", tabName = "tab1", icon = icon("dashboard"))
)
),
body <- dashboardBody(
tabItems(
tabItem(
tabName = "tab1",
uiOutput("species_dropdown"),
DT::dataTableOutput("table1"),
textOutput("text1"),
uiOutput("plots")
)
)
)
)
server <- function(input, output) {
output$species_dropdown <- renderUI({
pickerInput(
"var1",
"Species:",
choices = species,
options = pickerOptions(
actionsBox = T,
header = "Close",
liveSearch = T
),
multiple = T
)
})
filtered_data <- reactive({
map(input$var1, ~ iris %>% filter(Species == .x)) %>% set_names(input$var1)
})
output$plots <- renderUI({
req(input$var1)
plot_output_list <- lapply(input$var1, function(i) {
plotname <- paste("plot_", i, sep = "")
plotOutput(plotname, height = 280, width = 250)
})
do.call(flowLayout, plot_output_list)
})
observeEvent(filtered_data(), {
iwalk(filtered_data(), ~ {
output[[paste0("plot_", .y)]] <<- renderPlot({
ggplot(.x, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
labs(title = .y, x = "Sepal Length", y = "Sepal Width") # how to make and integrate dynamic subtitles from output$text1 ?
})
})
})
df <- reactive({
req(input$var1)
iris %>%
filter(Species == input$var1)
})
output$table1 <- DT::renderDataTable({
df()
})
output$text1 <- renderText({
df() %>% select(new) %>% distinct() %>% pull()
})
}
shinyApp(ui, server)
We can use the information provided by filtered_data and inside the walk function, create during each iteration a variable called subt that will capture the unique values from new column.
observeEvent(filtered_data(), {
iwalk(filtered_data(), ~ {
subt <- pull(., new) %>%
unique() %>%
str_c(collapse = ",")
subt <- paste("Unique values are:", subt)
output[[paste0("plot_", .y)]] <<- renderPlot({
ggplot(.x, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
labs(title = .y, subtitle = subt, x = "Sepal Length", y = "Sepal Width") # how to make and integrate dynamic subtitles from output$text1 ?
})
})
})
Full app:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tidyverse)
species <- c("setosa", "versicolor", "virginica")
iris %>% filter(Species == "setosa")
vals1 <- rep(c("a", "b"), 25)
vals2 <- rep(c("c", "d"), 25)
vals3 <- rep(c("e", "f"), 25)
vals <- c(vals1, vals2, vals3)
iris <- iris %>%
mutate(new = vals)
ui <- dashboardPage(
dashboardHeader(title = "title"),
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("General Overview", tabName = "tab1", icon = icon("dashboard"))
)
),
body <- dashboardBody(
tabItems(
tabItem(
tabName = "tab1",
uiOutput("species_dropdown"),
DT::dataTableOutput("table1"),
textOutput("text1"),
uiOutput("plots")
)
)
)
)
server <- function(input, output) {
output$species_dropdown <- renderUI({
pickerInput(
"var1",
"Species:",
choices = species,
options = pickerOptions(
actionsBox = T,
header = "Close",
liveSearch = T
),
multiple = T
)
})
filtered_data <- reactive({
map(input$var1, ~ iris %>% filter(Species == .x)) %>% set_names(input$var1)
})
output$plots <- renderUI({
req(input$var1)
plot_output_list <- lapply(input$var1, function(i) {
plotname <- paste("plot_", i, sep = "")
plotOutput(plotname, height = 280, width = 250)
})
do.call(flowLayout, plot_output_list)
})
observeEvent(filtered_data(), {
iwalk(filtered_data(), ~ {
subt <- pull(., new) %>%
unique() %>%
str_c(collapse = ",")
subt <- paste("Unique values are:", subt)
output[[paste0("plot_", .y)]] <<- renderPlot({
ggplot(.x, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
labs(title = .y, subtitle = subt, x = "Sepal Length", y = "Sepal Width") # how to make and integrate dynamic subtitles from output$text1 ?
})
})
})
df <- reactive({
req(input$var1)
iris %>%
filter(Species == input$var1)
})
output$table1 <- DT::renderDataTable({
df()
})
output$text1 <- renderText({
df() %>%
select(new) %>%
unique() %>%
pull()
})
}
shinyApp(ui, server)

Connect rangeslider R Shiny to plotly plot

So a plotly plot has an embedded rangeslider however I do not like the looks of it. The rangeslider in R Shiny looks much better and professional, however how do i connect the two?
Lets say you have a dataframe with some values and a daterange like:
library(lubridate)
df <- data.frame(
"Date" = c(seq(ymd('2015-09-15'), ymd('2015-09-24'), by = "1 days")),
"values" = c(3,6,5,3,5,6,7,7,4,2)
)
Code for the plotly plot
library(plotly)
plot_df <- plot_ly(df)
plot_df <- plot_df %>% add_lines(type = 'scatter', mode = "lines",
x = ~Date, y = ~values)
Code Shiny
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotlyOutput("plotdf", height = 250)),
box(
title = "Controls",
sliderInput("Date", "", min = df$Date[1], tail(df$Date, 1), value = tail(df$Date, 1)
)
)
)
)
)
server <- function(input, output) {
output$plotdf<-renderPlotly({
plot_df
})
}
shinyApp(ui, server)
We can use dplyr::filter and pipe it to plot_ly().
output$plotdf<-renderPlotly({
filter(df, Date <= input$Date) %>%
plot_ly() %>%
add_lines(type = 'scatter', mode = "lines",
x = ~Date, y = ~values)
})
Edit: Below is the plot code separated from the app with a sliderInput to select a range of dates.
library(shiny)
library(dplyr)
library(lubridate)
library(plotly)
source(file = 'my_functions_script.R', local = TRUE)
df <- data.frame(
"Date" = c(seq(ymd('2015-09-15'), ymd('2015-09-24'), by = "1 days")),
"values" = c(3,6,5,3,5,6,7,7,4,2)
)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotlyOutput("plotdf", height = 250)),
box(
title = "Controls",
shiny::sliderInput("Date", "", min = df$Date[1], tail(df$Date, 1), value = c(df$Date[1],tail(df$Date, 1))
)
)
)
)
)
server <- function(input, output) {
output$plotdf<-renderPlotly({
filter(df,Date >= input$Date[[1]], Date <= input$Date[[2]]) %>%
plt()
})
}
shinyApp(ui, server)

shiny: add/remove time-series to dygraphs upon input values

I'm building a shiny app that would display in dygraphs a basic dataset and then offer an option to add new time series upon selecting the checkbox input. However, as I coded it now, I'm 'stuck' at the original dataset and unable to add/remove new content. Any hints how to solve this are very welcome, thanks.
library(shinydashboard)
library(dygraphs)
library(dplyr)
ui <-dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
checkboxGroupInput(inputId = 'options',
label = 'Choose your plot(s)',
choices = list("mdeaths" = 1,
"ldeaths" = 2)
),
uiOutput("Ui1")
)
)
server <- function(input, output, session) {
output$Ui1 <- renderUI({
output$plot1 <- renderDygraph({
final_ts <- ldeaths
p <- dygraph(final_ts, main = 'Main plot') %>%
dygraphs::dyRangeSelector()
if(1 %in% input$options) {
final_ts <- cbind(final_ts, mdeaths)
p <- p %>%
dySeries('mdeaths', 'Male Deaths')
} else if(2 %in% input$options) {
final_ts <- cbind(final_ts, fdeaths)
p <- p %>%
dySeries('fdeaths', 'Female Deaths')
}
p
})
dygraphOutput('plot1')
})
}
shinyApp(ui, server)
I'd suggest to dynamically filter the data based on the user selection instead of dynamically adding/removing traces from the plot:
library(shinydashboard)
library(shinyjs)
library(dygraphs)
library(dplyr)
lungDeaths <- cbind(ldeaths, mdeaths, fdeaths)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
selectizeInput(
inputId = "options",
label = "Choose your trace(s)",
choices = colnames(lungDeaths),
selected = colnames(lungDeaths)[1],
multiple = TRUE,
options = list('plugins' = list('remove_button'))
),
uiOutput("Ui1")
)
)
server <- function(input, output, session) {
output$Ui1 <- renderUI({
filteredLungDeaths <- reactive({
lungDeaths[, input$options]
})
output$plot1 <- renderDygraph({
p <- dygraph(filteredLungDeaths(), main = 'Main plot') %>%
dygraphs::dyRangeSelector()
if('mdeaths' %in% colnames(filteredLungDeaths())){
p <- dySeries(p, 'mdeaths', 'Male Deaths')
}
if('fdeaths' %in% colnames(filteredLungDeaths())){
p <- dySeries(p, 'fdeaths', 'Female Deaths')
}
p
})
dygraphOutput('plot1')
})
}
shinyApp(ui, server)

Shiny: calculate cumsum based on dygraphs' RangeSelector

I'm building a shiny app where I want to plot a dataset with one of the variables being a cumulative sum of another variable. The latter needs to be re-calculated every time the start date of dygraphs' dyRangeSelector changes. Below is a basic code without cumsum calculations. Commented out code is what I tried, with no success.
library(shinydashboard)
library(stringr)
library(zoo)
library(dplyr)
library(dygraphs)
ui <-dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
uiOutput("Ui1")
)
)
server <- function(input, output, session) {
output$Ui1 <- renderUI({
# date range observer
# values <- reactiveValues()
#
# observeEvent(input$plot1_date_window, {
# from <- as.Date(str_sub(input$plot1_date_window[[1]], 1, 10))
# })
## dygraphs plot
output$plot1 <- renderDygraph({
m_df <- data.frame(date=as.Date(zoo::as.yearmon(time(mdeaths))), Y=as.matrix(mdeaths))
# input_data <- m_df %>%
# filter(date >= values$from) %>%
# mutate(cumY = cumsum(Y))
input_xts <- xts(select(m_df, -date),
order.by = m_df$date)
#select(input_data, -date),
#order.by = input_data$date)
p <- dygraph(input_xts) %>%
dyRangeSelector()
p
})
## outputs
dygraphOutput('plot1')
})
}
shinyApp(ui, server)
UPDATE
I modified #Pork Chop's answer to be able to plot the cumulative values with other metrics on one graph, but I'm not even able to display the plot now:
library(xts)
library(shiny)
library(shinydashboard)
library(dygraphs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
dygraphOutput('plot1'),
textOutput("cumsum1")
)
)
server <- function(input, output, session) {
m_df <- data.frame(date=as.Date(zoo::as.yearmon(time(mdeaths))), Y=as.matrix(mdeaths))
subdata <- reactive({
cumsum(m_df$Y[m_df$date >= as.Date(input$plot1_date_window[1]) & m_df$date <= as.Date(input$plot1_date_window[2])])
})
output$plot1 <- renderDygraph({
req(input$plot1_date_window)
input_xts <- xts(select(m_df, -date), order.by = m_df$date)
subdata_xts <- xts(select(subdata(), - date), order.by = subdata()$date)
final_xts <- cbind(input_xts, subdata_xts)
dygraph(final_xts) %>%
dyRangeSelector()
})
output$cumsum1 <- renderText({
req(input$plot1_date_window)
subdata <- cumsum(m_df$Y[m_df$date >= as.Date(input$plot1_date_window[1]) & m_df$date <= as.Date(input$plot1_date_window[2])])
subdata
})
}
shinyApp(ui, server)
The problem with your updated code is, that you didn't keep the date information. Also once you start rendering a plot based on a change of the plot itself (recursion) it gets a little tricky. You have to make sure that re-rendering the plot doesn't trigger the rendering again or you'll end up in a loop. That's why I set retainDateWindow = TRUE. Besides that you don't want the plot to re-render right away after the first change of the slider that's why I debounced the subdata.
Nevertheless, using dygraphs you still have the problem, that when you add cumsum as a series your plot for dyRangeSelector is changed (y maximum of all series). Please see the following code:
library(xts)
library(shiny)
library(shinydashboard)
library(dygraphs)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
dygraphOutput('plot1')
)
)
server <- function(input, output, session) {
m_df <- data.frame(date=as.Date(zoo::as.yearmon(time(mdeaths))), Y=as.matrix(mdeaths))
subdata <- reactive({
if(!is.null(input$plot1_date_window)){
subdata <- m_df[m_df$date >= as.Date(input$plot1_date_window[1]) & m_df$date <= as.Date(input$plot1_date_window[2]), ]
subdata$cumsum <- cumsum(subdata$Y)
subdata$Y <- NULL
} else {
subdata <- NULL
}
return(subdata)
})
subdata_d <- subdata %>% debounce(100)
output$plot1 <- renderDygraph({
input_xts <- xts(select(m_df, -date), order.by = m_df$date)
if(is.null(subdata_d())){
final_xts <- input_xts
} else {
subdata_xts <- xts(select(subdata_d(), - date), order.by = subdata_d()$date)
final_xts <- cbind(input_xts, subdata_xts)
}
p <- dygraph(final_xts) %>% dySeries(name="Y") %>%
dyRangeSelector(retainDateWindow = TRUE)
if("cumsum" %in% names(final_xts)){
p <- dySeries(p, name="cumsum", axis = "y2")
}
p
})
}
shinyApp(ui, server)
Just as #PorkChop mentioned I'd recommend multiple outputs for this scenario. Furthermore, I'd suggest to have a look at library(plotly) and it's event_data().
This should do the job, I think it is cleaner to have separate outputs for your dashboard
library(xts)
library(shiny)
library(shinydashboard)
library(dygraphs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
dygraphOutput('plot1'),
textOutput("cumsum1")
)
)
server <- function(input, output, session) {
m_df <- data.frame(date=as.Date(zoo::as.yearmon(time(mdeaths))), Y=as.matrix(mdeaths))
output$plot1 <- renderDygraph({
input_xts <- xts(select(m_df, -date), order.by = m_df$date)
dygraph(input_xts) %>%
dyRangeSelector()
})
output$cumsum1 <- renderText({
req(input$plot1_date_window)
subdata <- cumsum(m_df$Y[m_df$date >= as.Date(input$plot1_date_window[1]) & m_df$date <= as.Date(input$plot1_date_window[2])])
subdata
})
}
shinyApp(ui, server)