はじめに

Rでは、集計結果をサクッとWebアプリケーションとして作成するためのShinyというステキなパッケージが提供されています。Shinyを使えば、Webアプリケーションの知識があまり無くても、割と簡単にWebアプリが作れて、きれいなWebページでRによる集計結果を表示させることができます。さらにshinydashboardを組み合わせると、かなり使い勝手のよいアプリが作れます。
ただ、実用的なものを作ろうとすると細かいところで色々と詰まることがあったので、備忘録を兼ねてTipsをアップしていこうと思います。
(当記事ではShiny + shinydashboardを使用する前提で記述しています。)
今回は「UIオブジェクトの動的制御」についてです。

関連記事

インフラ屋さんのためのR言語: 環境構築編
 オフラインでのR環境構築 on RHEL
z/OSにRを導入してみた
 インフラ屋さんのためのR言語: プログラミング編
 R Markdownによるレポート生成
 R MarkdownのHTMLレポートをブラッシュアップ
 R - ShinyによるWebアプリケーション作成: 基礎編
 R - ShinyによるWebアプリケーション作成: shinydashboard編
 R - ShinyによるWebアプリケーション作成Tips: shinydashboardでの画面遷移制御
 R - ShinyによるWebアプリケーション作成Tips: UIオブジェクトの動的制御 <= 当記事
R - Shinyアプリ/管理サーバーテンプレート
 R - ShinyアプリでJリーグの勝点推移グラフを作成してみた

UIの動的制御関数

updateXXX関数

上の関連記事でも触れていますが、UIのオブジェクト(文字列の入力エリアとかチェックボックスとかスライダーバーとか日付入力用ウィジェットとか)は基本的にはui.Rに書いていきます。ただし、その内容はShinyアプリケーション起動時に読み込まれた静的な情報をベースに画面が生成されます。
処理結果や状況に応じてUIオブジェクトの内容を変更したい場合は多々あります。読み込んだデータを元にチェックボックスのリストを作ったり、アクセスした当日の日付をデフォルト値として設定したりなど...。
各UIオブジェクトは、大抵updateXXXという関数が用意されていて、動的に設定値などを上書きすることができます。例えば、

updateTextInput
updateCheckboxGroupInput
updateDateInput
...

などです。
これらはserver.Rで実装されます。例えば、server.Rの shinyServer(function(input, output, session) { ... }) の中でセッション毎に呼ばれる関数として以下のコードを実装すると、アクセスした日付を元にDateRangeオブジェクトの値を動的に変更できます。

server.R

...
updateDateRangeInput(session, inputId="dateRange_Test01",
                     start = "2016/01/01",
                     end = Sys.Date(),
                     max = Sys.Date())
...

上の例だと、範囲の開始日が2016/01/01, 終了日および選択可能な最大日付をアクセスした日に上書きしています。

まぁ、updateXXXの使い方は基本的にチュートリアルなどにもあるので分かりやすいかと思います。

htmlOutput(uiOutput)関数

当記事の本題に関係するのはこちらです。
htmlOutput(uiOutput)というオブジェクトはui.Rに定義しておくものですが、これはHTMLを指定の場所に配置しますよ、というものなのでかなり自由度が高く、UIを動的にいろいろ制御しようとする場合には便利に使えそうです。ガラだけ用意しておいて、そこに表示させるものは何でもOKみたいな感じでしょうか。

参考
Reference: Create an HTML output element
Gallery: Dynamically generated user interface components

上のGalleryを見ると使い方が分かりやすいと思います。

で、事の発端としては、Webアプリとして表示するオブジェクトの数を状況に応じて可変にすることはできないか？ということだったんですが、htmlOutput(uiOutput)を使うと割と簡単に実現できたので次の章で具体例をご紹介します。

表示させるUIオブジェクトの数を動的に制御する

元々、インフラ屋さんのための...ということで書き始めた記事の1つですので、ここでは具体例として、管理対象のサーバーが複数(不特定多数)あって、それらのCPU使用率、メモリ使用率、Disk使用率を管理する画面を作りたい、という要件があったとします。
(あんまりRっぽくないですが、この先にパフォーマンス分析などが出てくるという想定です。)
で、それらリソースの使用率を分かりやすく可視化するために、以下のような画面表示をさせたいと思っています。

valueBoxというオブジェクトを使って各リソースの使用率をiconと共に表示し、特定の閾値を超えたら色を変えてアラートを挙げる、というイメージです。
ここで、管理対象のサーバー(上の図のName01, Name02,...)の数は増えたり減ったりすることを前提とする、すなわち、このvaluBoxの図の行が増えたり減ったり動的に変わることを前提に作りたい訳です。

これを実現するためのコードを見ていきましょう。
(サンプルなので必要最低限のコードのみで中身は無いです。)

global.R

library(shiny)
library(shinydashboard)
library(shinyBS)

vectorName <- c("Name01","Name02","Name03")
vectorValue01 <- c(10,20,30)
vectorValue02 <- c(70,85,95)
vectorValue03 <- c(40,50,60)

dfData <- data.frame(Name=vectorName,
                     Value01=vectorValue01,
                     Value02=vectorValue02,
                     Value03=vectorValue03)

vectorResource <- c("CPU","Memory","Disk")

便宜上、ここではマシンの名前と各リソースの使用率をデータフレームとして静的に作成しています。サンプルなので値は適当です。実際は、各マシンのリソース使用率を何らかの方法で動的に取得して、データフレーム(dfData)として作成することを想定しています。
サンプルとして作成したデータフレームの中身はこんな感じになります。

    Name Value01 Value02 Value03
1 Name01      10      70      40
2 Name02      20      85      50
3 Name03      30      95      60

次はui部分です。

ui.R

source('ui_Info.R', local = TRUE)

source('ui_Menu01.R', local = TRUE)


dashboardPage(
  dashboardHeader(title = "Test01"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Information", icon=icon("info"), tabName = 'tab_Info'
      ),
      menuItem("Main01", icon=icon("th-list"), 
               menuSubItem("Menu01", tabName = "tab_Menu01")
      )
    )
  ),
  dashboardBody(

    tabItems(
      tabItem_Info,
      
      tabItem_Menu01

      
    )
  ),
  skin="blue"
)

ui_Menu01.R

tabItem_Menu01 <- 
  tabItem("tab_Menu01",
          h2("Menu01"),
          uiOutput("uiOut01_Menu01")

                        
)

以前書いた記事「R - ShinyによるWebアプリケーション作成: shinydashboard編」に従って、ファイル分割しています。ui_Menu01.Rの、uiOutput("uiOut01_Menu01")という箇所がポイントです。
ここに埋め込むUIオブジェクトを動的に作成していくことになります。(動的に作成するので、それはserver.Rで記述することになります)

次がいよいよserver.R部分です。

server.R

##### Options
options(scipen=100)
options(digits.secs=6)
Sys.setenv(TZ="Asia/Tokyo")

shinyServer(function(input, output, session) {
  # Import Files
  source('server_Menu01.R', local=TRUE)

})

server_Menu01.R

##### Functions
func_getMemoryColor <- function(value) {
  
  strColor <- "green"
  
  if (value >= 80) {
    strColor <- "yellow"
  }
  
  if (value >= 90) {
    strColor <- "red"
  }
  
  return(strColor)
  
}

##### Rndering
output$uiOut01_Menu01 <- renderUI({
  listValueBox <- list()
  for (i in 1:nrow(dfData)) {
    listValueBox[[i]] <- fluidRow(
      column(12,
             h3(dfData$Name[i]),
             fluidRow(
                 valueBox(value=paste(dfData$Value01[i],"%"),
                          subtitle=vectorResource[1],
                          icon=shiny::icon("cogs"),
                          color="green",
                          width=4
                   
                 ),

                 valueBox(value=paste(dfData$Value02[i],"%"),
                          subtitle=vectorResource[2],
                          icon=shiny::icon("bar-chart"),
                          color=func_getMemoryColor(dfData$Value02[i]),
                          width=4
                          
                 ),
                 valueBox(value=paste(dfData$Value03[i],"%"),
                          subtitle=vectorResource[3],
                          icon=shiny::icon("database"),
                          color="green",
                          width=4
                          
                 )
               
             )
      )
    )
    
  }
  
  listValueBox
})

こちらもファイル分割しているので、主役はserver_Menu01.Rです。ここでのポイントは、fluidRow(...)というshinydashbordの行単位の表示レイアウトを示すオブジェクトをリストとして繋げていって、それをdfData(管理対象となるマシンのリソース情報を格納したデータフレーム)の行数分、つまりマシンの数分だけ繰り返している、という点です。
最終的に出来上がったリスト(listValuBox)をrenderUI()の結果として返すことで、ここで組み立てられたレイアウト情報が指定の箇所(uiOut01_Menu01)に表示される、ということになります。
あとはdfDataの内容が変わったら表示を再生成するように、dfDataをreactive variableとして定義し、dfDataにデータを読み込む仕組みを作ってあげればOKですね。

※上の例では、Memoryの値だけ閾値指定で色を変えるための関数を定義して使っています。

表示させるUIオブジェクトの数を動的に制御する: その2 (tabBox)

shinydashboard提供のtabBox()で実現できる「タブ」を動的に生成する場合は、ちょっと工夫が必要です。
tabBox()では、tabBox全体のパラメーターと、そこに含まれる各タブ(TabPanel)を引数として指定します。すなわち、タブの数を動的に変更させようとすると、tabBox()の引数の数が可変になってしまうということになります。
そこで使用するのがdo.call関数です。do.callという関数を使うと、関数に対してパラメーターをリスト形式にして渡すことができます。

ui_Menu02.R

tabItem_Menu02 <- 
  tabItem("tab_Menu02",
          h2("Menu02"),
          fluidRow(
            tabBox(
              title = "Static", width = "100%",
              # The id lets us use input$tabset1 on the server to find the current tab
              id = "tabBox01", height = "250px",
              tabPanel("Tab1", "First tab",
                       h4("aaaaa"),
                       textInput("textIn01_Menu02",label = "textIn01:")),
              tabPanel("Tab2", "Second tab",
                       h4("bbbbb"),
                       textInput("textIn02_Menu02", label = "textIn02:"))
            )

          ),
          
          fluidRow(
              uiOutput("uiOut01_Menu02")
          )
)

server_Menu02.R

##### Rndering
output$uiOut01_Menu02 <- renderUI({
  listTabBoxVal      <- list(id="tabBox02", title="Dynamic", width = "100%")
  listTabBoxVal[[4]] <- tabPanel("Tab3", "Third tab",
                                 h4("ccccc"),
                                 textInput("textIn03_Menu02",label = "textIn03:"))
  listTabBoxVal[[5]] <- tabPanel("Tab4", "Fourth tab",
                                 h4("ddddd"),
                                 textInput("textIn04_Menu02",label = "textIn04:"))
  
  do.call(tabBox, listTabBoxVal)
  
})

上の例では、同じようなtabBoxを2つ、静的な定義(ui.Rで定義する方法)と、動的な定義(server.Rで動的に生成する方法)で作成しています。
簡易的に上の例ではserver.Rの方も固定でTab3, Tab4という2つのタブを生成させていますが、listTabBoxValにタブの中身を動的に追加していくことができますので、ロジック次第では、例えば読み込んだデータフレームの行数だけタブを追加する、ということもできます。

おわりに

htmlOutput(uiOutput) / renderUIを使うとHTMLのタグを自分で組み立てたりとかも出来るのでかなり自由に操作できると思います。
本来であれば、そういうことは意識しなくてもサクッと簡単にWebアプリが作れるのがShinyの良いところなんですが、凝ったもの/実用的なものを作ろうと思うと、細かい所で色々足りないことが出てきてしまうのが実情だと思います。そういう場合にはこの辺色々と使い出がありそうです。