Shiny Tips / dygraphsパッケージ

RのShinyパッケージのTipsです。たまに更新していきたいと思います。
以下は、私が日ごろよく見るサイトです。
Shinyの情報は英語のサイトではたくさん出るのですが、日本語で読める情報ソースはそう多くないので大変参考になります。
www.randpy.tokyo

dygraphsパッケージ

dygraphsパッケージは、JavaScriptのチャート作成ライブラリーへのRインターフェースです。
時系列データのビジュアル化にとてもおすすめです。
主な機能としては、

• xtsオブジェクト（またはxtsに変換可能な任意のオブジェクト）を自動的にプロット。
• ズーム/パン、ポイントハイライトなど豊富なインタラクティブ機能。
• 予測区間の表示。
• グラフオーバーレイ。

などがあります。
インストールは以下のコマンドで。

install.packages("dygraphs")

サンプル

今回は、quantmodパッケージに入っているサンプルを使って、dygraphによる図とRawデータを出力しました。
コードは最後にまとめて載せます。

Tips

Rawデータを出力しておいたのには理由があって、ちょっとした細工をしています。
下図では、レンジセレクターの範囲を2月に絞っていますが、連動してRawデータも同範囲だけ表示されるようにしています。
時系列データのグラフ化は大変便利ですが、気になる点をRawデータで直接確認したい場面が多々あると思います。
そんな時に役立つと思います。

ui

library(shiny)
library(shinydashboard)
library(dygraphs)
library(quantmod)　
library(xts)
library(zoo)
library(DT)


dashboardPage(
  dashboardHeader(title = 'dygraphs sample'),
  dashboardSidebar(
    sidebarMenu(
      menuItem("dygraphs", icon=icon("line-chart"), tabName = 'tab_dygraphs')
      )
    ),

  dashboardBody(
    tabItems(
      
      tabItem(
        
        "tab_dygraphs",
        
        box(dygraphOutput('res_dygraphs'),width = 12),
        
        fluidRow(
          shinydashboard::box(
            title = "dygraphs",
            width = 12,
            solidHeader = TRUE,
            collapsible = TRUE,
            status = "primary",
            DT::dataTableOutput('sample_df')
          )
        )

        )
      )
    )
  )

server

shinyServer(function(input, output) {

  df <- reactive({
    data(sample_matrix)
    df <- as.xts(sample_matrix)
    return(df)
  })

  server_var <- reactiveValues()  

  observeEvent(input$res_dygraphs_date_window,
               {
                 server_var$v1 <- input$res_dygraphs_date_window[[1]]
                 server_var$v2 <- input$res_dygraphs_date_window[[2]]
                 }
               )

  output$res_dygraphs <- renderDygraph({

    dygraph(df(), main = "SampleTimeSeries") %>%
      dyAxis("y", label = "y") %>%
      dyRangeSelector(height = 20, strokeColor = "red") %>%
      dyCrosshair(direction = "vertical") %>%
      dyHighlight(highlightCircleSize = 5,
                  highlightSeriesBackgroundAlpha = 0.2,
                  hideOnMouseOut = T)
    })

  output$sample_df <- DT::renderDataTable({
    df <- df()
    range <- paste(as.Date.character(server_var$v1), "::", as.Date.character(server_var$v2), sep = "")
    df <- df[range]
    as.data.frame(df)
  },

  filter = 'top',
  extensions = c('ColReorder', 'FixedColumns', 'Buttons'),
  options = list(colReorder = TRUE,
                 scrollY = 650,
                 scrollX = TRUE,
                 pageLength = 100,
                 fixedColumns = TRUE,
                 searchHighlight = TRUE,
                 buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
                 dom = 'Bfrtip'
  )
  )

  })