R Shiny のdashboardHeaderのカスタマイズ

2019.08.31

本日はShinyのdashboardHeaderをカスタマイズする方法です。

アプリ画面でヘッダーにどのような情報を掲載するかはかなり重要な要素となります。
画面ヘッダーに会社のロゴをいれてそこをクリックするとHPにジャンプしたり、ドロップダウンメニューを
クリックすると様々なアクションメニューにつなげられるようなギミックを作ってみます。

dashiboardHeaderの構成の確認

おさらい的に確認すると、ダッシュボードは以下に示したように、ヘッダー、サイドバー、ボディーからなる
ページで構成されます。

library(shiny)
library(shinydashboard)
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) {}
shinyApp(ui, server)

これを実行すると以下のような何もないフレームだけが出現します。これだけでも
サイドバーが動くボタンが出てくるところが、Shinyで素早い開発を可能にする
特徴なのかと思います。

f:id:okdata:20190831122040p:plain:w600

ヘッダーへのロゴの埋め込み

では最初にヘッダーの左端のタイトル部分にロゴを埋め込んでクリックすると
サイトにジャンプするページを作ります。

プログラムの見通しをよくするために、ヘッダー部分のプログラムをdbHeaderで
切り出しています。

表示に使うロゴ、ここではlogo.pngはShinyの作法にならってwwwホルダーに
入れておきます。

以下のプログラムを実行するとヘッダーの左端にロゴが出現して、そこをクリックすると
R Studioのサイトにジャンプします。ここを自分のサイトのアドレスやロゴに入れ替えれば
カスタマイズすることが可能になります。

library(shiny)
library(shinydashboard)
  dbHeader = dashboardHeader(
  title = tags$a(href="https://shiny.rstudio.com/",
  img(src="./logo.png", width="30px", height = "30px"),
  span("ABC Company", style="font-size: 20px; color: white; margin-left:10px;")
)
)
ui = dashboardPage(
  dbHeader,
  dashboardSidebar(),
  dashboardBody()
)
server <- function(input, output) {
}
shinyApp(ui, server)
f:id:okdata:20190831123247p:plain:w600

ドロップダウンメニューの追加

Shinyではドロップダウンメニューを簡単に組み込むことができます。

基本的な使い方は組み込み済みの3つのメニュー(message, notification, task)を
使う方法です。詳細はここ
をご覧ください。

このドロップダウンメニューのカスタマイズですが、 dashboardHeaderはliの要素＋dropdownクラスを使えば良いので
以下のような感じで設定すればOKです。

なお、badgeStatusはブートストラップのステータスを選択しますが、その場合メニューの件数がバッジで出てしまうので
ここではNULLとしています。

dbHeader = dashboardHeader(
  title = tags$a(href="https://shiny.rstudio.com/",
  img(src="./logo.png", width="30px", height = "30px"),
  span("ABC Company", style="font-size: 20px; color: white; margin-left:10px;")
),
dropdownMenu(
  headerText = tags$h4("TAB MENU"),
  icon = icon("power-off"),
  badgeStatus = NULL,
  tags$li(a(href = "https://shiny.rstudio.com/",
    img(src = "./question.png", width="30px", height = "30px"),
    span("Go to R Studio Home", style="padding-left: 10px; font-size: 16px;"),
    style = "padding-top:10px; padding-bottom:10px;"),
    class = "dropdown")
)
)

この例では画像(question.png)がドロップダウンメニューとして出てくるのでそれをクリックすると
R Studioのサイトにジャンプする仕掛けになっています。

ここのtags$li( )の内容を書き換えたり、増やしたりすれば様々なメニューが追加できます。

以下の例では、メニューを一つ増やしてLOG-OFFボタンを追加してみました（画像はお好きなものに
変えてください）

f:id:okdata:20190831130828p:plain:w600
dropdownMenu(
  headerText = tags$h4("TAB MENU"),
  icon = icon("power-off"),
  badgeStatus = NULL,
  tags$li(a(href = "https://shiny.rstudio.com/",
    img(src = "./question.png", width="30px", height = "30px"),
    span("Go to R Studio Home", style="padding-left: 10px; font-size: 16px;"),
    style = "padding-top:10px; padding-bottom:10px;"),
    class = "dropdown"),
  tags$li(div(id ="logoff", img(src = "./question.png", width="30px", height = "30px"),
    span("Log-OFF", style="padding-left: 10px; font-size: 16px;"),
    style = "padding-top:10px; padding-bottom:10px;padding-left: 10px; cursor:pointer;"),
    class = "dropdown")
)

ついでに

上記の例ではLOG-OFFのメニューを選んでも何も起こりませんが、これをクリックすると
modal画面が立ち上がるギミックを作ったのが以下の例です。

画像のクリックを認識するために、shinyjs()を使っています。
server側にクリックしたときのアクションが記述してありますが、
ここを変えることでクリック時の制御がいろいろと可能となります。
（useShinyjs()を忘れずに）

例えば、ログイン・ログオフ画面につなげるなどが期待されますが、
Shinyではログインや会員管理関連画面は標準で用意されておらず、Server PROや
shinyapps.ioなどR Studioの有料サービスを利用するか、画面の作り込みが
別途必要となりますので、また機会をあらためてご紹介したいと思います。

library(shiny)
library(shinydashboard)
library(shinyjs)
dbHeader = dashboardHeader(
  title = tags$a(href="https://shiny.rstudio.com/",
  img(src="./logo.png", width="30px", height = "30px"),
  span("ABC Company", style="font-size: 20px; color: white; margin-left:10px;")
),
dropdownMenu(
  headerText = tags$h4("TAB MENU"),
  icon = icon("power-off"),
  badgeStatus = NULL,
  tags$li(a(href = "https://shiny.rstudio.com/",
  img(src = "./question.png", width="30px", height = "30px"),
    span("Go to R Studio Home", style="padding-left: 10px; font-size: 16px;"),
    style = "padding-top:10px; padding-bottom:10px;"),
    class = "dropdown"),
  tags$li(div(id ="logoff", img(src = "./question.png", width="30px", height = "30px"),
    span("Log-OFF", style="padding-left: 10px; font-size: 16px;"),
    style = "padding-top:10px; padding-bottom:10px;padding-left: 10px; cursor:pointer;"),
    class = "dropdown")
  )
)
ui = fluidPage(
useShinyjs(),
dashboardPage(
dbHeader,
dashboardSidebar(),
dashboardBody()
)
)
server <- function(input, output) {
shinyjs::onclick(id = "logoff",
showModal(modalDialog(title = h3("LOG OFF"),
h4("Are you sure to log-off?"),
size = "l", easyClose = TRUE, footer = modalButton("Dismiss")))
)
}
shinyApp(ui, server)

念のためですが、fluidPage( )の部分は画面幅を調整するための関数ですが
必須ではありませんので以下のような形でも同じ結果です。

ui = {
useShinyjs()
dashBoardPage (
...
)
}