はじめに

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

関連記事

インフラ屋さんのための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リーグの勝点推移グラフを作成してみた

やりたいこと/目的

せっかくshinydashboardを使ってポータル的なWebアプリを作ったのであれば、各サブメニュー間でリンクを張って行き来させたい！という要望が出てくるのは普通だと思うのですが、標準機能ではその辺がなかなかうまく実現できません(基本は左側のメニューからサブパネルを選択するのみ)。
もう少し具体的にやりたいことをまとめるとこんな感じです。

ハイパーリンク: あるメニュー内の本文中にハイパーリンクを埋め込んで、クリックすると別のサブメニューが開くようにする
画面遷移時に入力オブジェクトへの値指定: ハイパーリンクで画面を遷移する際に引数を一緒に渡して、その値を遷移先画面のUIオブジェクトの入力として使用
初期表示画面の動的制御: Shinyアプリを起動時に最初に表示させる画面を動的に変更する

上のようなshinydashboardを使ったアプリ内の画面遷移(メニュー間のリンク)について、JavaScriptのコードを組み合わせることで実装できることが分かったので実装方法をまとめていきます。

ハイパーリンク

Shinyは最終的にはHTMLやjavascriptがWebアプリとして実装されるので、どのような形でWeb画面が生成されるのかを少し紐解いてみます。

例えば、以下のようなサブメニューを含むアプリをshinydashboardを使って実装したとします。

ui.R

...
  dashboardSidebar(
    sidebarMenu(
      menuItem("Information", icon=icon("info"), tabName = 'tab_Info'
      ),
      menuItem("Main01", icon=icon("th-list"), 
               menuSubItem("Menu01", tabName = "tab_Menu01")
      ),
      menuItem("Main02", icon=icon("th-list"),
               menuSubItem("Menu02", tabName = "tab_Menu02")
      )
    )
  ),
...

このShinyアプリをブラウザで開いて、ソースを表示させると、こんな感じになっています。

...
    <aside class="main-sidebar">
      <section class="sidebar">
        <ul class="sidebar-menu">
          <li>
            <a href="#shiny-tab-tab_Info" data-toggle="tab" data-value="tab_Info">
              <i class="fa fa-info"></i>
              <span>Information</span>
            </a>
          </li>
          <li class="treeview">
            <a href="#">
              <i class="fa fa-th-list"></i>
              <span>Main01</span>
              <i class="fa fa-angle-left pull-right"></i>
            </a>
            <ul class="treeview-menu">
              <li>
                <a href="#shiny-tab-tab_Menu01" data-toggle="tab" data-value="tab_Menu01">
                  <i class="fa fa-angle-double-right"></i>
                  Menu01
                </a>
              </li>
            </ul>
          </li>
          <li class="treeview">
            <a href="#">
              <i class="fa fa-th-list"></i>
              <span>Main02</span>
              <i class="fa fa-angle-left pull-right"></i>
            </a>
            <ul class="treeview-menu">
              <li>
                <a href="#shiny-tab-tab_Menu02" data-toggle="tab" data-value="tab_Menu02">
                  <i class="fa fa-angle-double-right"></i>
                  Menu02
                </a>
              </li>
            </ul>
          </li>
        </ul>
      </section>
    </aside>
...

ここで、<a href="#shiny-tab-tab_Menu02" data-toggle="tab" data-value="tab_Menu02"> という所に注目して下さい。shinydashboardにおけるサブメニューは、HTMLにおけるタブで実装されていることが分かります。Menu02をクリックすると該当するタブにページがジャンプするよう<a>タグによりリンクが張られています。
このことを利用して、自分で埋め込んだハイパーリンクがクリックされた時に、裏で指定のメニューをクリックする動作を埋め込んであげればよいということになります。
具体的に見ていきます。

まず、Shinyアプリでは独自に作成したJavaScriptを組み込むことができるので、"サブメニューをクリックする"というアクションをJavaScriptのコードで書きます。汎用的に使うために関数として実装しておきます。

  function openTab_SubMenu(strSubMenu) {
    $('a', $('.sidebar')).each(function() {
      if(this.getAttribute('data-value') == strSubMenu) {
        this.click()
      };
    });
  };

この関数では、タブ名(ui.RのtabNameで定義した名前)を引数に渡すと、<a>タグからdata-value=<*タブ名*>に指定されている要素を探してそれをクリックする、ということを行っています。

JavaScriptのコードは、tags$script(HTML("xxx"))という形でui.Rに指定します。(埋め込む場所はとりあえずdashboardBodyの先頭でよいでしょう)
また、管理しやすさのためにJavaScript用のファイルは別にしておくとよいと思います。

javaScript.R

strJavaScript01 <-
  "function openTab_SubMenu(strSubMenu) {
    $('a', $('.sidebar')).each(function() {
      if(this.getAttribute('data-value') == strSubMenu) {
        this.click()
      };
    });
  };"

ui.R

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

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

source('ui_javaScript.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")
      ),
      menuItem("Main02", icon=icon("th-list"),
               menuSubItem("Menu02", tabName = "tab_Menu02")
      )
    )
  ),
  dashboardBody(
    tags$script(HTML(strJavaScript01)),
    
    tabItems(
      tabItem_Info,
      
      tabItem_Menu01,
      tabItem_Menu02      
    )
  ),
  skin="blue"
)

余談ですが...
上の例を見て頂くと分かるように、Shinyに埋め込むJavaScriptのコードは単なる文字列として埋め込むことになります。つまり、RStudio上ではJavaScriptとしての構文チェックなどは行えません(まぁ当然ですが)。複雑なJavaScriptを作る場合、別途JavaScript用のエディターも併用して構文チェックはそちらで実施するといった工夫もするとよいでしょう。

さて、次にこれを使って、Menu01の画面の中にハイパーリンクを埋め込んで、そこをクリックしたらMenu02に遷移するコードを書いてみましょう。

ui.R

...
  tabItem("tab_Menu01",
          h2("Menu01"),
          a(href="#", p("Link To Menu02"), onClick="openTab_SubMenu('tab_Menu02')"),
...

この例ではハイパーリンク(<a>タグ)に相当する a()関数を使っています。onClickにて、先ほど定義した関数が呼ばれて、サイドバーメニューの"Menu02"がクリックされる、ということになります。(onClickで呼ばれるJavaScriptで画面遷移を行うことを想定しているので、hrefで指定する宛先はダミーとしてページ先頭にジャンプする"#"を指定しています。)

Menu01で、ハイパーリンクをクリックすると...

Menu02に遷移します！

うまくいきました...が、今回の例では、メニューが以下のような階層になっています。
Main01
└Menu01
Main02
└Menu02
右側の本体部分はきちんと意図したとおりに画面が遷移したのですが、左側のメニューを見ると、Menu01が表示されたままになってしまっています(Menu02が展開されていない)。これはちょっと気持ち悪いですね。

先の例と同様に、親のMain02をクリックして、サブメニューのMenu02をクリックする、というように拡張してみます。

先のHTMLを見返すと、親のメニューの表示部分は以下のような構造になっています。サブメニューの場合とちょっと構造が違っています。

            <a href="#">
              <i class="fa fa-th-list"></i>
              <span>Main02</span>
              <i class="fa fa-angle-left pull-right"></i>
            </a>

親のメニューをクリックするための関数をJavaScriptで書いてみるとこんな感じになります。

  function openTab_MainMenu(strMainMenu) {
    $('a', $('.sidebar')).each(function(){
      var spanElement=this.getElementsByTagName('span')[0];
      if (spanElement) {
        var spanString=spanElement.textContent;
        if (spanString == strMainMenu){
          this.click()
        }
      }
    });
  };

この関数では<a>タグの要素に含まれる<span>タグの値が指定したタブ名だったらその要素をクリックする、ということを行います。
※JavaScriptのコードは、全部まとめて1つの文字列変数(先の例だとjavaScript.RのstrJavaScript01)に追加指定すればOKです(後続のJavaScriptも同様)。

さらに、メインメニューのクリックとサブメニューのクリックの2つのアクションをまとめて行う上位の関数をつくります。

  function onClick01(strMainMenu, strSubMenu) {
    openTab_MainMenu(strMainMenu);
    openTab_SubMenu(strSubMenu);
  };

これを実行するui.Rのコードは以下のようになります。

ui.R

...
  tabItem("tab_Menu01",
          h2("Menu01"),
          a(href="#", p("Link To Menu02"), onClick="onClick01('Main02','tab_Menu02')")
...

これで再度実行してみます。
リンクをクリックした直後の画面を見てみると...

きちんと左側のメニューもMain02が展開されました！

画面遷移時に入力オブジェクトへの値指定 (テキスト入力オブジェクト)

次に、画面遷移を行った先に、入力用のUIオブジェクトがある場合、画面遷移に合わせてそこに値をセットする、ということを実装してみます。

例えば、遷移先の画面に以下のような入力フィールドがあったとします。

画面定義の例はこちら。

ui.R

  tabItem("tab_Menu02",
          h2("Menu02"),         
          textInput("textIn01_Menu02", label="textIn01", placeholder="input text"),
          textOutput("textOutMessage_Menu02")          
)

ハイパーリンクをクリックした時にonClickでJavaScriptの関数を呼び出して画面遷移をさせますが、それに合わせて上のtextInputオブジェクト(textIn_Menu02)に対して値を動的にセットさせたいすることを考えます。
これを実装するにあたっては、以下の記事が非常に参考になりました。
参考: Sending data from client to server and back using shiny
(この記事の"Sending data from client to server"の箇所参照)

JavaScriptからShiny.onInputChangeという関数を使用することで、Shinyのオブジェクトに対して値をセットすることができます。
汎用的に使用するために、任意のtextInputオブジェクトに対して任意の値をセットするコードを関数として実装します。

  function setTextInput(strInputId, strText) {
    Shiny.onInputChange(strInputId, strText);
    document.getElementById(strInputId).value=strText;
  }

引数として設定しているstrInputIdは操作対象のtextInpuオブジェクトのID, strTextはそこにセットする文字列を想定しています。
Shiny.onInputChange関数を使用すると、ShinyアプリとしてtextInputオブジェクトに値がセットされたことになり、それをトリガーにEventが発火されたりしますが、これだけだと画面上の入力フィールドには値は表示されません。
そのため、document.getElementById...で値を明示的に表示させるようにしています。
冗長なようですが、意図したように設定するには両方必要なようです。

この関数も合わせて呼び出すように、onClick01関数も変更してみます。

  function onClick01(strMainMenu, strSubMenu, strTextInputId01, strText01) {
    openTab_MainMenu(strMainMenu);
    openTab_SubMenu(strSubMenu);
    setTextInput(strTextInputId01, strText01);
  };

引数として、textInputオブジェクトのID(strTextInpuId01)とセットする値(strText01)を追加しています。その値を使って、先ほど定義してsetTextInputを呼び出すようにしています。

これに合わせてui.Rのコードも変更してみます。

ui.R

  tabItem("tab_Menu01",
          h2("Menu01"),
          a(href="#", p("Link To Menu02"), onClick="onClick01('Main02','tab_Menu02', 'textIn01_Menu02','Updated Text')")                        
)

これで、リンクをクリックした時に、onClickの引数で指定した値(Updated Text)がtextInputオブジェクトに設定されます。

上の例ではハイパーリンクを実装しているのはui.Rで、静的にセットした値を受け渡ししているだけなのであまり面白みが無いですが、状況に応じて受け渡しする値を変更することで色々応用がきくと思います。

画面遷移時に入力オブジェクトへの値指定 (その他の入力オブジェクト)

画面遷移時には、単純なtextInputだけでなく、プルダウンメニュー(selectInput)や、カレンダーオブジェクト(dateInput)なども上書きしたいケースがあります。
しかし、JavaScriptからShinyのオブジェクトにアクセスするShiny.onInputChangeは、textInputにしか使えなさそうですし、他のメソッドも見当たりません。
そこで、隠しオブジェクトとしてtextInputを用意して一旦そこに値をセットした後、Shinyのロジックで最終ターゲットの入力オブジェクト(selectInputやdateInputなど)に値をセットする、という仕組みで対応したいと思います。
イメージとしては以下の通りです。

リンク先でアップデートしたいオブジェクトの例として、今回はプルダウンメニュー(selectInput)2つを使用します。
コードは以下の通りです。

gloabl.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")

ui.R

  tabItem("tab_Menu02",
          h2("Menu02"),          
          selectInput("selInEnvironment_Menu02", label="Environment",
                      choices = dfData$Name,
                      selected = dfData$Name[1]),
          selectInput("selInResource_Menu02", label="Resource",
                      choices = vectorResource,
                      selected = vectorResource[1]),
          textOutput("textOutMessage_Menu02")                     
)

データは適当です。以下の2つのselectInputを定義しています。
selInEnvironment_Menu02 (選択肢: "Name01","Name02","Name03")
selInResource_Menu02 (選択肢: "CPU","Memory","Disk")
これらをリンク時に隠しオブジェクト経由でアップデートします。

さて、"隠しオブジェクト"というのは、HTMLで言うところのtype=hiddenを指定したタグみたいなものを想定して頂ければよいです。オブジェクトはあるけど画面には見せないようにするというものです。shinydasyboardを使っていると、そういうのも結構簡単に作れます。他と同様に普通にui.Rにサブメニューのタブを定義して、sidebarMenuからそのタブへのリンクを張らないければよいだけです。(以下コード例のコメントアウト部分。開発時にはデバッグ用にコメントアウトをはずしておくと分かりやすい。)

ui.R

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

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

source('ui_javaScript.R', local = TRUE)
source('ui_hidden.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")
      ),
      menuItem("Main02", icon=icon("th-list"),
               menuSubItem("Menu02", tabName = "tab_Menu02")
      )
      #,menuItem("Hidden", tabName = "tab_hidden")
    )
  ),
  dashboardBody(
    tags$script(HTML(strJavaScript01)),
    tabItems(
      tabItem_Info,
      tabItem_Menu01,
      tabItem_Menu02,
      tabItem_hidden
    )
  ),
  skin="blue"
)

ui_hidden.R

tabItem_hidden <- 
  tabItem("tab_hidden",
          h2("Hidden"),
          textInput(inputId="hiddenTextIn01_Menu02", label="hiddenTextIn01"),
          textInput(inputId="hiddenTextIn02_Menu02", label="hiddenTextIn02")
                        
)

今回は、2つのUIオブジェクトを変更させる想定のため、隠しオブジェクトも2つ定義しておきます。

リンクのクリック時に実行される関数もそれに合わせて修正します。

  function onClick01(strMainMenu, strSubMenu, strTextInputId01, strText01, strTextInputId02, strText02) {
    openTab_MainMenu(strMainMenu);
    openTab_SubMenu(strSubMenu);
    setTextInput(strTextInputId01, strText01);
    setTextInput(strTextInputId02, strText02);
  };

これに合わせて呼び出し側のui.Rのコードも変更します。

ui.R

  tabItem("tab_Menu01",
          h2("Menu01"),
          a(href="#", p("Link To Menu02"), onClick="onClick01('Main02','tab_Menu02', 'hiddenTextIn01_Menu02','Name03', 'hiddenTextIn02_Menu02','Memory')")                    
)

これで、Menu02のタブをクリックすると、隠しオブジェクトのtextInputの値が更新されます。(上の例では1つ目のselectInputには"Name03"、2つ目には"Memory"を指定してます。)

最後に、隠しオブジェクトの変更をトリガーとして、目的のselectInputオブジェクトの値を上書きするコードを追加します。

server.R

...
observe({
  strText <- input$hiddenTextIn01_Menu02
  selectedItem <- NULL
  for (i in 1:nrow(dfData)){
    if (strText == dfData$Name[i]){
      selectedItem <- strText
    }
  }
  
  if (!is.null(selectedItem)){
    updateSelectInput(session, "selInEnvironment_Menu02", selected=selectedItem)
  }
})

observe({
  strText <- input$hiddenTextIn02_Menu02
  selectedItem <- NULL
  for (i in 1:length(vectorResource)){
    if (strText == vectorResource[i]){
      selectedItem <- strText
    }
  }
  
  if (!is.null(selectedItem)){
    updateSelectInput(session, "selInResource_Menu02", selected=selectedItem)
  }
})

output$textOutMessage_Menu02 <- renderText({
  paste0("selected: ", input$selInEnvironment_Menu02, " / ", input$selInResource_Menu02)
})
...

最初の2つのobserve()で、2つのselectInputの値を上書きしています。
さらに、それらのselectInputの変更を受けて、textOutputオブジェクト(textOutMessage_Menu02)の値をアップデートしています。(selectInputの変更がきちんと他のEventを発生させるトリガーになることを確認するため。)

これらのコードを適用して、画面遷移をさせてみます。
画面遷移直後のイメージです。

選択肢がデフォルト値から上書きされて、かつ、末尾のtextOutputにもその変更が反映されているのが分かります。

初期表示画面の動的制御

最後に、これまでの画面遷移を応用し、Shinyアプリへの接続時に、指定のサブメニューを表示させ、UIオブジェクトの値を上書きする、ということをやってみます。
表示するメニューや上書きする値はURLのタブ指定とquery stringで指定するようにします。
例:
http://localhost:3838/Shinyapp?Name=Name03&Resource=Memory#tab_Menu02
というような指定をすると、tab_Menu02を開いて、selectInputオブジェクトから"Name03", "Memory"を選択する、というようなことが出来るようにします。

JavaScriptで、URLからquery string(URL中の?var=value指定)を取得するロジックを関数として実装します。

  function getUrlVars(){
    var vars = [], max = 0, hash = '', array = '';
    var query = window.location.search.slice(1).split('&');
    max = query.length;

    for (var i = 0; i < max; i++) {
      array = query[i].split('=');
      vars.push(array[0]);
      vars[array[0]] = array[1];
    }
    return vars;
  }

同様に、URLからタブ指定(URL中の#tab指定)を取得するロジックを関数として実装します。

  function getUrlHash(){
    var hash = window.location.hash.slice(1);
    return hash;
  }

Shinyアプリに接続した時のイベントを拾ってJavaScriptの関数を実行させることができます。
参考: JavaScript Events in Shiny
上で定義した関数を使って、Shinyアプリ接続時にURLからquery stirngとtab指定の値を判別し、さらに、前節で作成した関数を呼び出すことで、画面遷移、selectInputオブジェクトの上書きを行います。

  $(document).on('shiny:connected', function(event) {
    var hash = getUrlHash();
    var vars = [];
    
    if(hash == 'tab_Menu02') {
      vars = getUrlVars()
      openTab_MainMenu('Main02');
      openTab_SubMenu(hash);
      setTextInput('hiddenTextIn01_Menu02', vars['Name']);
      setTextInput('hiddenTextIn02_Menu02', vars['Resource']);
    }
  });

これで準備はできたので、試してみましょう。

URLで指定した値に従って、表示メニュー、selectInputの内容がきちんと変更されました！

おわりに

Shiny + shinydashboardでかなり使い勝手のよいWebアプリが作れますが、さらにここで紹介した画面遷移の制御を組み合わせると、色々とできることの幅が広がると思います。できればJavaScriptをあまり直接意識しなくても標準機能でこの辺できるとよいんですけど...