向 shinydashboard dygraphs 添加可选的可视化功能。例如。阴影平均值 +/- 标准偏差区域

Question

由于缺少更好的词，我正在寻找一种好方法来为我在 shinydashboard (R) 中的 dygraph 图表添加可选的可视化辅助工具，例如平均线平均值和一个和两个标准偏差的阴影区域。

更详细：

我正在制作ui一个闪亮的仪表板，其中显示了带有 dygraph 的时间序列数据。我希望添加可以单击（和关闭）的其他可视化功能。目前我在 ui 中使用 checkboxInput，例如：

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)

然后使用 dyGraphs 代码让它工作：

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"))

此方法适用于网格选项，适用于平均线，但 (a) 有限：例如，两个标准差 ("twostd") 的阴影区域仅绘制在它延伸的地方超出一个标准偏差的区域 ("onestd") & (b) 丑陋：备牌刻度间隔 quite 很远。

我正在寻找更好的方法，(a) 不涉及当前实施的颜色选项，并且 (b) 产生更紧凑的仪表板侧边栏。

谢谢

=========================================== ========================= 当前代码：

# =================================================== #
# ====== #
#   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)

Answer 1

您可能希望将此行添加到 renderDygraph，以设置时间序列数据的 y 值范围：dyAxis("y", valueRange = c(mn - 3*std, mn + 3*std)) 使其看起来更好。

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"))

要满足您的要求，您可以执行以下操作：

(a) 只需删除颜色选项 (b) 使用 1 个选择输入替换 3 个复选框输入。

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)

向 shinydashboard dygraphs 添加可选的可视化功能。例如。阴影平均值 +/- 标准偏差区域

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

r

dygraphs

shiny

shinydashboard