Shiny modules 小品〜値によって色が変わるvalueBox 〜 #R

shinydashboard パッケージの valueBox() 関数はダッシュボード上に数値を直接表示する際に利用できるウィジェットです。背景に色を付けたり、アイコンを並べたりして見た目を調整することができます。
renderValueBox() 関数と valueBoxOutput() 関数とを使用すると、サーバー側で動的にvalueBoxを作成することもできます。

本記事で紹介する例では、表示する値が0以下なら赤色、0より大きければ緑色というように、値に応じて動的に見た目が変化するvalueBoxを作成しました。さらにShiny modulesの仕組みを使ってそれを再利用可能にしました。

デモ

デモアプリをこちらで公開しています

スクリーンショット

サイドバー内のスライダーを操作するとvalueBoxの値に反映されるようになっています。
値が0以下か1以上かによってvalueBoxの色やアイコンなどが変化します。

ソースコード

デモアプリのソースコードは app.R ファイルただ１つで、以下のような内容になっています（GitHubでも同じものを公開しています）:

app.R

library(shiny)
library(shinydashboard)

# Shiny modulesを使って conditionalValueBox を定義 ----------
conditionalValueBoxUI <- function(id) {
  ns <- NS(id)

  tagList(
    valueBoxOutput(ns("valueBox"))
  )
}

conditionalValueBox <- function(input, output, session, value) {
  output$valueBox <- renderValueBox({
    valueBox(
      subtitle = ifelse(value() > 0, "いいね", "わるいね"),
      value = value(),
      color = ifelse(value() > 0, "green", "red"),
      icon = icon(ifelse(value() > 0, "thumbs-up", "thumbs-down"))
    )
  })
}

# UI側 ----------
ui <- dashboardPage(
  dashboardHeader(title = "Shiny modues 小品"),
  dashboardSidebar(
    sliderInput(inputId = "value1", label = "値1", value = -2, min = -5, max = 5),
    sliderInput(inputId = "value2", label = "値2", value = 1, min = -5, max = 5)
  ),
  dashboardBody(
    h2("値によって色が変わる valueBox"),
    p("値が1以上なら緑色、0以下なら赤色になる"),

    fluidRow(column(
      12,
      h3("値1について"),
      conditionalValueBoxUI("vb1")
    )),

    fluidRow(column(
      12,
      h3("値2について"),
      conditionalValueBoxUI("vb2")
    ))
  )
)

# サーバー側 ----------
server <- function(input, output) {
  callModule(conditionalValueBox, "vb1", reactive(input$value1))
  callModule(conditionalValueBox, "vb2", reactive(input$value2))
}

# アプリの起動 ----------
shinyApp(ui = ui, server = server)

ポイント

モジュールの定義

Shiny modulesの規約にしたがってモジュールを作成するため、conditionalValueBoxUI と conditionalValueBox という２つの関数を定義しています:

conditionalValueBoxUI <- function(id) {
  ns <- NS(id)

  tagList(
    valueBoxOutput(ns("valueBox"))
  )
}

conditionalValueBox <- function(input, output, session, value) {
  output$valueBox <- renderValueBox({
    valueBox(
      subtitle = ifelse(value() > 0, "いいね", "わるいね"),
      value = value(),
      color = ifelse(value() > 0, "green", "red"),
      icon = icon(ifelse(value() > 0, "thumbs-up", "thumbs-down"))
    )
  })
}

サーバー側の処理を定義する関数 conditionalValueBox(input, output, session, value) で、４番目の引数 value はモジュールの呼び出し元から値を受け取るために使用します。
この値に応じて renderValueBox の結果が変化するようにしています。

ここで注意点として、この value は reactiveな表現式 であるという前提になっています。単に value ではなく後ろに括弧を付けて value() という使い方をされているのはそのためです。

モジュールの呼び出し（UI）

次にUI定義でモジュールを呼び出している箇所を見ると

conditionalValueBoxUI("vb1")

および

conditionalValueBoxUI("vb2")

のようにして、同じモジュール conditionalValueBoxUI を異なるID "vb1", "vb2" でそれぞれ呼び出しています。

モジュールの呼び出し（サーバー）

一方サーバー側におけるモジュールの呼び出し方は次のようになっています:

server <- function(input, output) {
  callModule(conditionalValueBox, "vb1", reactive(input$value1))
  callModule(conditionalValueBox, "vb2", reactive(input$value2))
}

ここで callModule() 関数の第3引数として、入力値を reactive(input$value1) のように reactiveな表現式 にしてから渡しています。これがモジュールを定義した関数 conditionalValueBox(input, output, session, value) の第4引数 value として利用されます。

参考

valueBoxの基本用法についてはこちらの公式ドキュメントに書かれています。
モジュールに値を渡す際にreactiveな表現式を使うことについては以前の記事で紹介しました。

Shiny Dashboardのより基本的な内容については

Shiny Dashboard （公式ページ）

が英語ながらわかりやすく書かれています。

Shiny modulesについては

などが、reactiveについては

などの解説があります。

Shiny modules 小品 〜 値によって色が変わるvalueBox 〜

デモ