Question

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

更详细：

我正在构建一个闪亮的仪表板，用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”）＆amp; （b）丑陋：餐具柜的蜱间隔很远。

我正在寻找一种更好的方法，（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 selectinput替换3个checkboxInput。

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添加可选的可视化功能。例如。阴影平均值+/-标准差区域

1 个答案: