Shiny で DT + sparkline を使う

はじめに

この記事は R Advent Calendar 2019 10日目の記事です。

DT で作ったテーブルに sparkline を埋め込んだものを Shiny で使いたい。

最終的な成果物として次のようなものを作りたい。

1. sparkline

sparkline は文章中や表の中に埋め込むことのできる小さなグラフ (small inline chart) である。

具体例としては次のサイトを見てほしい。

• jQuery Sparklines

これは R では sparkline パッケージで簡単に使える (CRAN からインストールできる)。

library(sparkline)
sparkline(iris$Sepal.Length, type = "box")

2. DT

DT パッケージを使うと高機能でインタラクティブなテーブルが簡単に作成できる。

• An Introduction to the DT Package

library(DT)
library(tidyverse)

df <- iris %>%
  group_by(Species) %>%
  summarise(Median = median(Sepal.Length), IQR = IQR(Sepal.Length))
datatable(df)

3. DT + sparkline

DT で作成したテーブルの中に sparkline のグラフを埋め込むには次のようにする。

df$Sparkline <- iris$Sepal.Length %>%
  split(iris$Species) %>%
  map(~ sparkline(.x, type = "box")) %>%
  map(htmltools::as.tags) %>%
  map_chr(as.character)

datatable(df, escape = FALSE) %>% spk_add_deps()

ただし、これだと sparkline の各グラフは独立に作られるため比較ができない。

そこで、各グラフの最小値と最大値を固定すると良い。

my_sparkline_box <- function(x) {
  sparkline(x, type = "box", 
            chartRangeMin = min(iris$Sepal.Length), 
            chartRangeMax = max(iris$Sepal.Length))
}

df$Sparkline <- iris$Sepal.Length %>%
  split(iris$Species) %>%
  map(my_sparkline_box) %>%
  map(htmltools::as.tags) %>%
  map_chr(as.character)

datatable(df, escape = FALSE) %>% spk_add_deps()

4. Shiny への組み込み

目的のテーブルができたので、これを Shiny アプリに組み込みたい。

しかし、普通に組み込んでも sparkline のグラフが表示されない。

解決法は、次のサイトを参考にした。

• Composited Sparkline in R with DT and Shiny - Stack Overflow

最終的なコードは次のようになった。

library(shiny)
library(DT)
library(sparkline)
library(tidyverse)

ui <- fluidPage(
    titlePanel("Sparkline in DT"),
    sidebarLayout(NULL,
        mainPanel(
           dataTableOutput("table_with_sparkline")
        )
    )
)

server <- function(input, output) {
    output$table_with_sparkline <- renderDataTable({
        df <- iris %>% 
            group_by(Species) %>%
            summarise(Median = median(Sepal.Length), IQR = IQR(Sepal.Length))
        
        my_sparkline_box <- function(x) {
            sparkline(x, type = "box", 
                      chartRangeMin = min(iris$Sepal.Length), 
                      chartRangeMax = max(iris$Sepal.Length))
        }
        
        df$Sparkline <- iris$Sepal.Length %>%
            split(iris$Species) %>%
            map(my_sparkline_box) %>%
            map(htmltools::as.tags) %>%
            map_chr(as.character)

        draw_callback <- htmlwidgets::JS("function(){HTMLWidgets.staticRender()}")
        dt_options <- list(fnDrawCallback = draw_callback)
        datatable(df, options = dt_options, escape = FALSE) %>%
            spk_add_deps()
    })
}

shinyApp(ui = ui, server = server)

目的のものが得られた。

Enjoy!

参考

estrellita.hatenablog.com

RとShinyで作るWebアプリケーション