Add optional visualization features to shinydashboard dygraphs. E.g. shaded mean +/- standard deviation area

For the lack of better words I'm looking for a good approach to add optional visualization aids to my dygraph graphs in shinydashboard (R), such as a line for mean value and a shaded area for one and two standard deviation(s) from the mean.

In more detail:

I'm building a shiny dashboard displaying timeseries data with a dygraph. I'm looking to add additional visualization features that can be clicked on (and off). Current I'm using checkboxInput in my ui, such as:

checkboxInput("showgrid", label = "Show Grid", value = FALSE),
checkboxInput("mean", label = 'Display Mean Daily High', value = FALSE),
checkboxInput("onestd", label = 'Mean Centered Standard Deviation', value = FALSE),
checkboxInput("twostd", label = 'Mean Centered 2 Standard Deviations', value = FALSE)

and then play with the dyGraphs code to kinda make it work:

dygraph(dailyhigh.xts, main = "dailyhigh Over Time")  %>%
  dyAxis("y", valueRange = c(mn - 3*std, mn + 3*std)) %>%
  dyOptions(drawGrid = input$showgrid) %>%
  dyLimit(if(input$mean == TRUE) {mn}, color = 'black') %>%
  dyShading(from = mn - 2*std, to = mn + 2*std, axis = "y", color=ifelse(input$twostd==TRUE, "lightgrey", "white")) %>%
  dyShading(from = mn - std, to = mn + std, axis = "y", color=ifelse(input$onestd==TRUE, "darkgrey", "white"))

This approach works well for the grid option and reasonably well for the mean line, but is (a) Limited: for example the shaded area for two standard deviations ("twostd") is only plotted where it stretches beyond the area of one standard deviation ("onestd") & (b) Ugly: the sideboard ticks are spaced quite far apart.

I'm looking for a better approach, that (a) does not involve the color option, as implemented currently and (b) results in a more compact dashboard sidebar.

Thanks

====================================================================== Current Code:

# =================================================== #
# ====== #
#   Shiny Graph Examples  #
# ===== #
# =================================================== #

# ===== #
# Packages, Libraries and Source Code
# ===== #

# === Libraries
require(shiny)
require(shinydashboard)
require(dygraphs)
require(xts)

# === Data
mydata <- read.table(header=TRUE, text="
                     date dailyhigh   dailylow weeklyhigh weeklylow
                     2012-01-01 3.173455 0.44696251   2.520812 0.9406211
                     2012-02-01 2.923370 1.60416341   3.481743 0.9520305
                     2012-03-01 2.984739 0.05719436   4.534701 0.6622959
                     ")


    ###START THE APP
    # ======================
    ui <- dashboardPage( 
      skin="yellow",
      dashboardHeader(
        #title="Playing with Sentiment Data",
        #titleWidth = 450
      ),
      dashboardSidebar(

        checkboxInput("showgrid", label = "Show Grid", value = FALSE),
        checkboxInput("mean", label = 'Display Mean Daily High', value = FALSE),
        checkboxInput("onestd", label = 'Mean Centered Standard Deviation', value = FALSE),
        checkboxInput("twostd", label = 'Mean Centered 2 Standard Deviations', value = FALSE)

      ),
      dashboardBody(
        #boxes to be put in a row (or column)

        fluidRow( 
          box(status="primary",solidHeader = TRUE,dygraphOutput("dygraph_line"), height='100%', width='100%'))
        )
      )


    server <- function(input, output) { 

      #Graph for Tab 1: Line Graph Normal

      output$dygraph_line <- renderDygraph({


        # set Dates
        mydata$date = as.Date(mydata$date)

        # calc mean + std
        mn = mean(mydata$dailyhigh, na.rm=T)
        std = sd(mydata$dailyhigh, na.rm=T)

        # set up data as xts timeseries data
        dailyhigh.xts = xts(coredata(mydata$dailyhigh), order.by=mydata$date)

        dygraph(dailyhigh.xts, main = "dailyhigh Over Time")  %>%
          dyAxis("y", valueRange = c(mn - 3*std, mn + 3*std)) %>%
          dyOptions(drawGrid = input$showgrid) %>%
          dyLimit(if(input$mean == TRUE) {mn}, color = 'black') %>%
          dyShading(from = mn - 2*std, to = mn + 2*std, axis = "y", color=ifelse(input$twostd==TRUE, "lightgrey", "white")) %>%
          dyShading(from = mn - std, to = mn + std, axis = "y", color=ifelse(input$onestd==TRUE, "darkgrey", "white"))

      })

    }

    shinyApp(ui, server)

Solution

You may want to add this line to renderDygraph, to set the range of y values of the time series data: dyAxis("y", valueRange = c(mn - 3*std, mn + 3*std)) to make it look better.

dygraph(dailyhigh.xts, main = "dailyhigh Over Time")  %>%
      dyAxis("y", valueRange = c(mn - 3*std, mn + 3*std)) %>%
      dyOptions(drawGrid = input$showgrid) %>%
      dyLimit(if(input$mean == TRUE) {mn}, color = 'black') %>%
      dyShading(from = mn - 2*std, to = mn + 2*std, axis = "y", color=ifelse(input$twostd==TRUE, "lightgrey", "white")) %>%
      dyShading(from = mn - std, to = mn + std, axis = "y", color=ifelse(input$onestd==TRUE, "darkgrey", "white"))

To address your requirements, you can do the following:

(a) simply remove the color option (b) use 1 selectinput to replace 3 checkboxinputs.

ui <- dashboardPage( 
  skin="yellow",
  dashboardHeader(
    #title="Playing with Sentiment Data",
    #titleWidth = 450
  ),
  dashboardSidebar(

    checkboxInput("showgrid", label = "Show Grid", value = FALSE),
    selectInput("stats", "Select statistics", c('None', 'mean', 'mean+-sd', 'mean+-2sd'))        

  ),
  dashboardBody(
    #boxes to be put in a row (or column)

    fluidRow( 
      box(status="primary",solidHeader = TRUE,dygraphOutput("dygraph_line"), height='100%', width='100%'))
  )
)


server <- function(input, output) { 

  #Graph for Tab 1: Line Graph Normal

  output$dygraph_line <- renderDygraph({


    # set Dates
    mydata$date = as.Date(mydata$date)

    # calc mean + std
    mn = mean(mydata$dailyhigh, na.rm=T)
    std = sd(mydata$dailyhigh, na.rm=T)

    # set up data as xts timeseries data
    dailyhigh.xts = xts(coredata(mydata$dailyhigh), order.by=mydata$date)

    d <- dygraph(dailyhigh.xts, main = "dailyhigh Over Time")  %>%
      dyAxis("y", valueRange = c(mn - 3*std, mn + 3*std)) %>%
      dyOptions(drawGrid = input$showgrid) %>%
      dyLimit(if(input$stats != "None") {mn}) # show mean if None is not selected

    if (input$stats=='mean+-sd') {
      d <- d %>% dyShading(from = mn - std, to = mn + std, axis = "y")
    } else if (input$stats=='mean+-2sd') {
      d <- d %>% dyShading(from = mn - 2*std, to = mn + 2*std, axis = "y")          
    }

    d
  })

}

shinyApp(ui, server)