向shinydashboard动态图添加可选的可视化功能。例如，阴影平均值+；/-标准差面积

由于缺少更好的词汇，我正在寻找一种好方法，在shinydashboard（R）中为我的动态图添加可选的可视化辅助工具，例如一条线表示平均值，一个阴影区域表示平均值的一个和两个标准差

更详细的信息：

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

我正在构建一个闪亮的仪表板，用动态图显示timeseries数据。我希望添加额外的可视化功能，可以点击（和关闭）。当前我正在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)

然后使用动态图代码使其工作：

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）丑陋：餐具柜刻度间隔相当远

我正在寻找一种更好的方法，即（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)

#===============================================================================================================#
# ====== #
#闪亮图形示例#
# ===== #
# =================================================== #
# ===== #
#包、库和源代码
# ===== #
#==库
需要（有光泽）
要求（仪表板）
需要（动态图）
需要（xts）
#==数据
mydata%
阴影消除（从=mn-2*std到=mn+2*std，axis=“y”，color=ifelse（输入$twostd==TRUE，“浅灰色”，“白色”））%>%
阴影消除（从=mn-std，到=mn+std，axis=“y”，color=ifelse（输入$onestd==TRUE，“暗灰色”，“白色”））
})
}
shinyApp（用户界面、服务器）

您可能希望将这一行添加到

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)

---

ui我非常感谢您的输入。不幸的是，它没有回答我最初的问题，但它确实有助于将问题可视化@Moritz替代（更通用）设计可以是mean复选框和k=0,1,2的selectinput，以显示mean+-k.sd。