formattableでshinyに推定結果をオシャレに表示する

R Shiny Advent Calendar 2018 18日目です。

この記事では、統計分析した結果をshinyで簡単にイイ感じで表示する方法を紹介します。

実際の場面だとこんな感じ

LASSO回帰の結果を表示。

LASSO回帰で予測に使用されている箇所を太字、符号を色で表現することで
数表であっても結果が読みやすくなっています。

formattableとは

dataframeに簡単にイイ感じの書式を設定してくれるパッケージ。
戻り値がhtmlなので、shinyとの相性が抜群です。

shinyでdataframeを表示するパッケージにDTもありますが、
結果表の出力にはformattableの方が便利です。

formattableの機能整理

以下ではformattableの機能を順番に紹介していきます。
データとして、気象庁から日本の気温データを使用したいと思います。

気象庁HP

データの準備

library(tidyverse)
library(magrittr)
library(formattable)

raw <- read_csv(
  'https://www.data.jma.go.jp/cpdinfo/temp/list/csv/mon_jpn.csv',
  locale=locale(encoding="CP932"))

raw %<>% filter(年 >= 2014) # 直近5年分に絞り込み

# 時系列の持ち方を変形
raw %<>% gather(month, temp, -年) %>% 
  mutate(month = factor(month, levels=unique(month), ordered=T)) %>% 
  spread(年, temp)

まずはそのまま出力

formattable(raw)

前述の通りhtmlに出来ますが、ここでは画像で掲載します。

このままで十分使えるなのでは...という印象です。
ただ、そもそも表って、作った人が思っているより伝わりにくいものです。
Gelman先生の名言
そこで、以下で書式を設定していきます。

太字、文字色

もちろんできます。
formattableでは、基本的に

列名 = formatter

で書式の名前付きリストを作ることで、書式を設定していきます。

# 太字、文字色 ----
raw %>% formattable(
  list(
    month = formatter("span", style=style(
      font.weight="bold",
      color="orange"
      ))
    )
  )

とても簡単ですね。

ヒートマップ的なアレコレ

excelでおなじみのカラースケールやデータバーですね。
color_tableやcolor_barをformatterの代わりに渡します。
color_barは負値があると挙動が怪しいので、normalize_barを使います。

# color_tile, color_bar
raw %>% formattable(
  list(
    `2014` = color_tile("transparent", "#71CA97"),
    `2015` = normalize_bar("lightblue")
  )
)

お手軽にexcel likeな書式設定が可能です。

area

これまでの書式だと、複数列に書式を適用するのがとても面倒です。
そもそもshinyは動的な処理があってこそなので、列名が事前にわかっているとは限りません。
そんなときにareaを使って処理します。

基本的な文法は
area(row, col) ~ formatter
です。

# area ----
raw %>% formattable(
  list(
    area(col = `2014`:`2018`) ~ color_tile("transparent", "lightblue"),
    month = formatter("span", style=style(font.weight="bold"))
  )
)
raw %>% formattable(
  list(
    area(row = 1:6  ,col = 4:6) ~ formatter("span", style=style(font.weight="bold", color="steelblue")),
    area(row = 7:12  ,col = 2:4) ~ formatter("span", style=style(font.weight="bold", color="orange")),
    month = formatter("span", style=style(font.weight="bold"))
  )
)

こんな感じで、手軽に範囲に対しても書式設定を行うことができます。
※ただし、同一セルに複数の書式を適用するのは結構難しいので注意。

カスタマイズ系

たいていの統計的な結果は、条件付き書式、つまりif条件で適用するべきものが多いかと思います。
気温の例でいうと、

• 「平均気温より高いか低いか（気温偏差の正負）」
• 「極端な気温があったのはどこか（１偏差以上のずれがあったのはどこか）」

これをformattableで書いてみます。
基本的にはifelseやcase_whenで書くことができます。

# if文
raw %>% formattable(
  list(
    `2014` = formatter(
      "span",
      style = x ~ style(color = ifelse(x > 0, "green", "red"),
                        font.weight = ifelse(abs(x) > 1, "bold", NA)))
  )
) 

formatterの中でローカル変数を挟むのがコツです。
私の周囲の冬モノを売る事業者の方はかなり大変そうにしていましたが、
これをみると、2018年の11月はかなり暖かったみたいです。

もちろん複数列に対する条件も書くことができます。
2017年から気温が増加したか、減少したかで色を付けてみましょう。

raw %>% formattable(
  list(
    `2018` = formatter(
      "span",
      style = ~ style(color = ifelse(`2018` > `2017`, "green", "red"))
    )
  )
)

とても楽チンですね。

icontext

色だけでなく、アイコンが付いていると、表が華やかになります（本質的ではないが...）。
icontextを使うと、bootstrap glyphiconsのアイコンを使用することができます。
Components
矢印と符号ぐらいしか使いませんが...

raw %>% formattable(
  list(
    area(col=`2014`:`2017`) ~ formatter(
      "span",
      style = x ~ style(color = ifelse(x > 0, "green", "red"),
                        font.weight = ifelse(abs(x) > 1, "bold", NA))),
    `2018` = formatter(
      "span",
      style = x ~ style(color = ifelse(x > 0, "green", "red"),
                        font.weight = ifelse(abs(x) > 1, "bold", NA)),
      ~ icontext(ifelse(`2018` > `2017`, "arrow-up", "arrow-down"), `2018`)
      )
    )
  )

たった1行でアイコンが追加できるのは嬉しいですね。

shinyでの実装

formattableには、ui.Rで使うformattableOutputとserver.Rで使うrenderFormattableが用意されているので、これを使うだけのお手軽実装です。

library(shiny)
library(tidyverse)
library(magrittr)
library(formattable)


ui <- fluidPage(

  titlePanel("formattable"),

  fluidRow(
    column(8,
           formattableOutput("table")
    )
  )
)

server <- function(input, output) {

  raw <- read_csv(
    'https://www.data.jma.go.jp/cpdinfo/temp/list/csv/mon_jpn.csv',
    locale=locale(encoding="CP932"))

  raw %<>% filter(年 >= 2014) # 直近5年分に絞り込み

  # 時系列の持ち方を変形
  raw %<>% gather(month, temp, -年) %>% 
    mutate(month = factor(month, levels=unique(month), ordered=T)) %>% 
    spread(年, temp)

  output$table <- renderFormattable(
    # icontext ----
    raw %>% formattable(
      list(
        month = formatter("span", style=style(font.weight="bold")),
        area(col=`2014`:`2017`) ~ formatter(
          "span",
          style = x ~ style(color = ifelse(x > 0, "green", "red"),
                            font.weight = ifelse(abs(x) > 1, "bold", NA))),
        `2018` = formatter(
          "span",
          style = x ~ style(color = ifelse(x > 0, "green", "red"),
                            font.weight = ifelse(abs(x) > 1, "bold", NA)),
          ~ icontext(ifelse(`2018` > `2017`, "arrow-up", "arrow-down"), `2018`)
        )
      )
    )
  )
}
shinyApp(ui = ui, server = server)

おわりに

formattableを使うことで、読みやすい表が簡単に作ることができます。

shinyの使用用途は色々だと思いますが、特にRが得意な統計的処理を行うためのインターフェースとして用いるなら、結果は数表となることも多いかと思います。

shinyなら入出力はサクッと仕上げ、メインの統計処理やデバッグに時間を使うことが出来るのが魅力だなあと感じています。

今後

カレンダーに余裕があれば、統計的因果推論をshinyで実装した話を書こうと思います。