43 Shiny で作るダッシュボード

ダッシュボードは多くの場合、他の人と分析の結果を共有する場合に非常に良い方法です。shiny パッケージを利用してダッシュボードを作成することは、R 言語について、比較的高度な知識が必要ですが、大いなる可能性と自由を与えてくれます。

shiny パッケージを用いたダッシュボードについて学ぶ人は、データの加工と可視化についてある程度理解していることが必要です。また、コードのデバッグや関数を書くことについても慣れている必要があります。ダッシュボードの作成は、最初は分かりにくく、ときに理解することが難しいでしょう。しかし、このスキルは学ぶ価値のあるもので、習熟とともに簡単になっていきます!

この章では、shiny パッケージとその拡張パッケージによるダッシュボード作成について短く概要をお伝えします。 この方法とは別に、速く簡単でしかし自由度は低い方法でのダッシュボード作成方法については flextable パッケージの章(R Markdownで作るダッシュボード)を参考にしてください。

43.1 準備

パッケージの読み込み

このハンドブックでは、パッケージを読み込むために、pacman パッケージの p_load() を主に使用しています。p_load() は、必要に応じてパッケージをインストールし、現在の R セッションで使用するためにパッケージを読み込む関数です。また、すでにインストールされたパッケージは、R の基本パッケージである base (以下、base R)の library() を使用して読み込むこともできます。R のパッケージに関する詳細は R の基礎の章をご覧ください。

まずは、R パッケージの shiny をインストールするところからはじめていきます:

pacman::p_load("shiny")

データのインポート

もしあなたがこのページのコードを理解したいのであればハンドブックとデータのダウンロードの章を見てください。そこには最終的な Shiny アプリを作成するための R のスクリプトとデータファイルへのリンクがあります。

これらのファイルを利用してアプリを再構築する場合は、解説の過程で作成される R のプロジェクトのフォルダ構造に注意してください(例 “data” フォルダや “funcs” フォルダ)。

43.2 Shiny アプリの構造

基本的なファイル構造

shiny について理解するためには、まずアプリのファイル構造がどのように機能するかを理解する必要があります!まず、新しいディレクトリを作成する必要があります。これは、R Studioで、New Projectを選び、Shiny Web Application を選択することで簡単に作成できます。この操作で、shiny アプリの基本的な構造が作成されます。

このプロジェクトをひらくと、すでにapp.Rという名前の .R ファイルが作成されています。次の 2 つのうちのいずれか 1 つのファイル構造をとることが必須です:

  1. app.R、という名前の 1 つのファイルあるいは
  2. 一方が ui.R でもう一方が server.R という名前の 2 つのファイル

この章では、app.R という名前をつける 1 つ目の方法を利用します。以下が例となるスクリプトです:

# app.R の例

library(shiny)

ui <- fluidPage(

    # アプリのタイトル
    titlePanel("My app"),

    # スライダーインプットウィジェットを含むサイドバー
    sidebarLayout(
        sidebarPanel(
            sliderInput("input_1")
        ),

        # グラフを表示する
        mainPanel(
           plotOutput("my_plot")
        )
    )
)

# ヒストグラムを描画するためのサーバーロジック関数を定義
server <- function(input, output) {
     
     plot_1 <- reactive({
          plot_func(param = input_1)
     })
     
    output$my_plot <- renderPlot({
       plot_1()
    })
}


# アプリを実行する
shinyApp(ui = ui, server = server)

ファイルを開くと、2 つのオブジェクトが定義されています - 1 つは ui オブジェクトで、もう 1 つは server オブジェクトです。これらのオブジェクトは全ての shiny アプリで定義する必要があり、アプリ自体の構造の中心です!実際には、上記で説明した 2 つのファイル構造間の違いは以下のみです。構造 1 では、ui オブジェクトと server オブジェクトが 1 つのファイルで定義されているのに対して、構造 2 では別々のファイルで定義されているだけです。注意:他の .R ファイルを source() 関数を利用してアプリで利用することも可能です(これは大規模なアプリでは必須となります)。

server オブジェクトと ui オブジェクト

次に、実際に server オブジェクトと ui オブジェクトが何をするかを理解しなければなりません。一言でいうと、ユーザーが shiny アプリを操作するときに、常にこれら 2 つのオブジェクトが互いに作用しあいます。

shiny アプリのユーザインタフェース(以下 UI)要素は、基本的なレベルにおいては、HTML インターフェイスを作る R のコードです。つまり、アプリの UI に表示されているものすべてを意味します。一般的には次のようなものを含みます:

  • 「ウィジェット」 - ドロップダウンメニュー、チェックボックス、スライダーなどユーザーが操作できるもの
  • プロット、表など - R のコードで作成できる出力
  • アプリのナビゲーションに関する要素 - タブ、ペインなど
  • 一般的なテキスト、ハイパーリンクなど
  • HTML と CSS 要素 (後に解説します)

UI において最も大切なことは、ui オブジェクトはユーザーから入力を受け取り、server オブジェクト内のロジックを生成する関数(以下、サーバーロジック関数)から受け取った出力を表示するということです。どのような時でも、ui オブジェクトの中でアクティブなコードが動くことはありません。UI における全ての変化は(多かれ少なかれ)サーバーロジック関数を経由したものです。そのため、プロットの表示やダウンロードなどの処理はサーバーロジック関数の中で実行する必要があります。

アプリが立ち上がれば、shiny アプリのサーバーロジック関数はすべてのコードが実行される関数となります。この挙動は少し混乱しやすいです。サーバーロジック関数はユーザーが UI を操作すると効果的にreact(反応)し、それに応じてコードを実行します。もしサーバーロジック関数内でなにかが変われば、その変化は ui オブジェクトに再度渡され、その変化が表示されます。大切なことは、サーバーロジック関数内のコードが非連続的に実行される(と考えておくことが良いでしょう)という点です。 基本は、ui オブジェクトがサーバーロジック関数内のコードに影響を与えた場合は常に、自動的にサーバーロジック関数内のコードが実行されて、アウトプットオブジェクトが作成・表示されます。

この一連の動作は、今は難解に聞こえると思います。なので、これが実際にどのように動くかをいくつか例を体験して明快にしましょう。

アプリを作成する前に

アプリを作る前に、何を作りたいかを知ることはとても役立ちます。あなたが作る UI はコードで書かれるため、何か具体的なものを狙って作成しなければ、何を作っているかを可視化することができません。このような理由から、何が shiny アプリとして作れるか、沢山の例を見てアイデアを得ておくことは非常に有効です。もし、それらのアプリのソースコードを見ることができればもっと良いでしょう!この目的のための素晴らしいリソースは次のリンクにあります:

どんなことができるかのイメージを持つことができれば、それをもとにどのような見た目のアプリを作りたいかを描いてみることも助けになります。 - これは、紙に書いても、絵を描くソフトを利用してもよいでしょう (PowerPoint、 MS paint、 など)。 最初のアプリは、単純なもので開始するのもよいでしょう!ネットでみつけたすごいアプリのコードをひな型として利用することを恥ずかしがる必要はありません - 全くのゼロから作ることに比べればはるかに楽に作ることができます!

43.3 UI の作成

アプリを作成する際には、最初に UI を作成した方が、何を作っているのかがわかりやすく、サーバーロジック関数のエラーでアプリがうまく動かなくなるリスクもありません。前述したように、UI を作成する際にはテンプレートを使用するのが良いでしょう。shiny アプリで利用できる標準的なレイアウトが沢山、shiny 基本パッケージに含まれています。また、shinydashboard のような拡張パッケージが沢山存在することを知っておいてもよいでしょう。まずは shiny の基本例を使って説明します。

shiny の ui オブジェクトは、一般的に次のような順序でネスト(入れ子になった)した関数として定義されます。

  1. 一般的なレイアウトを定義する関数(最も基本的なものとしては fluidPage() があるが、他にも沢山存在)
  2. レイアウトの中のパネル群:
  3. ウィジェット関数とアウトプット関数 - これらは入力をサーバーロジック関数に送ったり(ウィジェット関数)、出力をサーバーロジック関数から受け取ったり(アウトプット関数)する
    • ウィジェット関数は一般的には xxxInput() のような名前となっています 例 selectInput()
    • アウトプット関数は一般的には xxxOutput() のような名前となっています 例 plotOutput()

繰り返しになりますが、これらは抽象的で、可視化することは簡単ではありません、そのため、例を見るのが一番です! マラリア施設数のデータを地区ごとに視覚化する基本的なアプリを作ってみましょう。 このデータは多くのパラメータを持っているので、エンドユーザーが自分で抽出して、年齢層や地区別にデータを見ることができれば素晴らしいです。とても単純な shiny のレイアウトを利用しましょう - サイドバーレイアウトです。これは、左側のサイドバーにウィジェットを配置し、右側にプロットを配置したレイアウトです。

どのようなアプリにするかを計画しましょう。まずは、可視化したい地区を選択することができるセレクターからはじめましょう。次いで、別のセレクターを利用して興味のある年齢のグループ可視化します。これらの抽出条件を用いて、これらのパラメータを反映した流行曲線(エピカーブ)を表示することを目指しましょう。このために必要なのは:

  1. 望む地区と興味のある年齢を選ぶことができる 2 つのドロップダウンメニュー。
  2. 結果として出力されるエピカーブを表示する領域

これは次のようなものです:

library(shiny)

ui <- fluidPage(

  titlePanel("Malaria facility visualisation app"),

  sidebarLayout(

    sidebarPanel(
         # 地区の選択用インプットウィジェット
         selectInput(
              inputId = "select_district",
              label = "Select district",
              choices = c(
                   "All",
                   "Spring",
                   "Bolo",
                   "Dingo",
                   "Barnard"
              ),
              selected = "All",
              multiple = TRUE
         ),
         # 年齢の選択用インプットウィジェット
         selectInput(
              inputId = "select_agegroup",
              label = "Select age group",
              choices = c(
                   "All ages" = "malaria_tot",
                   "0-4 yrs" = "malaria_rdt_0-4",
                   "5-14 yrs" = "malaria_rdt_5-14",
                   "15+ yrs" = "malaria_rdt_15"
              ), 
              selected = "All",
              multiple = FALSE
         )

    ),

    mainPanel(
      # 流行曲線(エピカーブ)の描画
      plotOutput("malaria_epicurve")
    )
    
  )
)

上記の UI コードを使用して(server オブジェクト部分に何もコードがない状態で)app.R が実行されると、レイアウトは下記のようになります - プロットはサーバーロジック関数部分がないため描画されていませんが入力部分は動いていることに注意してください!

入力部分は、ウィジェットがどのように機能するか説明する良い機会です。 - それぞれのウィジェットは inputIdlabel など各ウィジェット型に特有のオプションを設定することができます。 inputId は非常に重要です。これらは ui オブジェクトからサーバーロジック関数に情報を渡す ID として扱われます。そのため、ID は他と重複しないことが必要です。大規模なアプリの場合には、わかりやすい名前をつける努力が必要があり、ウィジェットで何を扱うのかを具体的に示す必要があります。

それぞれのウィジェットがどのような動作をするのかについて、完全な詳細を把握するにはドキュメント(公式文書)を注意深く読む必要があります。ウィジェットはその型に応じて、特定のデータ型をサーバーロジック関数に渡します。このデータの流れについて完全に理解しなければなりません。例えば、selectInput() は文字型をサーバーロジック関数に渡します:

  • もし、最初のウィジェットで Spring を選択したら、それは、文字型オブジェクトである "Spring" をサーバーロジック関数に渡します。
  • もし、ドロップダウンメニューから 2 項目を選択した場合、それらは文字型ベクトルとして渡されます(例 c("Spring", "Bolo"))。

他のウィジェットは違う型のオブジェクトをサーバーロジック関数に渡します!例えば:

  • numericInput() は数字型オブジェクトをサーバーロジック関数に渡します
  • checkboxInput() はロジカル型オブジェクト(TRUEFALSE)をサーバーロジック関数に渡します

また、ここで年齢データに名前付きのベクトルを利用していることは注目に値するでしょう。 多くのウィジェットでは、名前付きベクトルを選択肢として利用すると、ベクトルの名前が選択できる表示として利用されますが、ベクトルのがサーバーロジック関数に渡されます。つまり、誰かが “15+” をドロップダウンメニューから選択した場合、UI は"malaria_rdt_15" をサーバーロジック関数に渡します。これは、処理などで利用したいデータの列名そのものです!

アプリで様々なことを行うために使用できるウィジェットがたくさんあります。 ウィジェットはアプリへのファイルのアップロードと出力のダウンロードも可能にします。基本的な shiny パッケージに含まれるウィジェットを拡張してくれる素晴らしいパッケージもあり、shinyWidgets パッケージはこのような拡張例の 1 つです。使用例を見るには次のリンクを確認してください:

43.4 アプリにデータを読み込む

アプリ開発の次のステップはサーバーロジック関数を動かすことです。これを実行するには、何らかのデータをアプリに入力しなければなりません。また、実行するべきすべての計算を理解する必要があります。エラーの発生している場所が明確がないことが多いため shiny アプリのデバッグは、簡単にはいきません。そのため、データの加工と可視化のコードが問題なく動くようになってからサーバーロジック関数を作り始められると理想的です。

したがって、ユーザーの入力に応じて変化する流行曲線(エピカーブ)を表示するアプリを作る状況では、この処理を通常の R スクリプトで実行するにはどのようなコードが必要かを考える必要があります。必要な工程は:

  1. パッケージの読み込み
  2. データの読み込み
  3. データの加工
  4. ユーザーの入力に応じてデータを可視化する関数の作成

上記のリストは非常にわかりやすく、それほど難しいことではないはずです。ここで重要なのは、このプロセスのうち、どの部分が一度だけ実行される必要があり、どの部分がユーザーの入力に応じて実行される必要があるのかを考えることです。なぜなら、shiny アプリは一般的には、アプリが実行される前にコードの一部分が一度だけ実行されるためです。大部分のコードをこの一度だけ実行される部分に移動することができれば、アプリのパフォーマンスが大きく改善するでしょう。この例では、データとパッケージの読み込みと基本的なデータの加工は一度の実行しか必要ありません。そのため、これらのコードをサーバーロジック関数の外に置くことができます。この変更の意味するところは、サーバーロジック関数の中に書く必要なコードは、可視化に関するコードだけということです。まず、これらの構成要素をすべてひとつのスクリプトとして開発してみましょう。ただし、今回は関数を使ってデータを可視化しているので、可視化をする関数のコードをサーバーロジック関数の外に置くことで、アプリの実行時に関数が実行環境中に存在するようにすることもできます。

最初に、データを読み込みましょう。現在、新しいプロジェクトで作業を行っており、このプロジェクト構造を整然なままにしたいので、新しい data というディレクトリを作成してマラリアデータをそこに保存しましょう。下記のコードは、アプリの構造を整える際に最終的に削除する予定のテスト用スクリプトであり、以下のように実行します。

pacman::p_load("tidyverse", "lubridate")

# データの読み込み
malaria_data <- rio::import(here::here("data", "malaria_facility_count_data.rds")) %>% 
  as_tibble()

print(malaria_data)
## # A tibble: 3,038 × 10
##    locat…¹ data_date  submitte…² Provi…³ Distr…⁴ malar…⁵ malar…⁶ malar…⁷ malar…⁸
##    <chr>   <date>     <date>     <chr>   <chr>     <int>   <int>   <int>   <int>
##  1 Facili… 2020-08-11 2020-08-12 North   Spring       11      12      23      46
##  2 Facili… 2020-08-11 2020-08-12 North   Bolo         11      10       5      26
##  3 Facili… 2020-08-11 2020-08-12 North   Dingo         8       5       5      18
##  4 Facili… 2020-08-11 2020-08-12 North   Bolo         16      16      17      49
##  5 Facili… 2020-08-11 2020-08-12 North   Bolo          9       2       6      17
##  6 Facili… 2020-08-11 2020-08-12 North   Dingo         3       1       4       8
##  7 Facili… 2020-08-10 2020-08-12 North   Dingo         4       0       3       7
##  8 Facili… 2020-08-10 2020-08-12 North   Bolo         15      14      13      42
##  9 Facili… 2020-08-09 2020-08-12 North   Bolo         11      11      13      35
## 10 Facili… 2020-08-08 2020-08-12 North   Bolo         19      15      15      49
## # … with 3,028 more rows, 1 more variable: newid <int>, and abbreviated
## #   variable names ¹​location_name, ²​submitted_date, ³​Province, ⁴​District,
## #   ⁵​`malaria_rdt_0-4`, ⁶​`malaria_rdt_5-14`, ⁷​malaria_rdt_15, ⁸​malaria_tot

tidy な形のデータを使用するほうが作業しやすいため、このデータを縦持ちのデータに変換する必要があります。年齢群が列になり、ケースも別の列になる形です。データの縦横変換の章で学んだようにこの処理は簡単にできます。

malaria_data <- malaria_data %>%
  select(-newid) %>%
  pivot_longer(cols = starts_with("malaria_"), names_to = "age_group", values_to = "cases_reported")

print(malaria_data)
## # A tibble: 12,152 × 7
##    location_name data_date  submitted_date Province District age_group   cases…¹
##    <chr>         <date>     <date>         <chr>    <chr>    <chr>         <int>
##  1 Facility 1    2020-08-11 2020-08-12     North    Spring   malaria_rd…      11
##  2 Facility 1    2020-08-11 2020-08-12     North    Spring   malaria_rd…      12
##  3 Facility 1    2020-08-11 2020-08-12     North    Spring   malaria_rd…      23
##  4 Facility 1    2020-08-11 2020-08-12     North    Spring   malaria_tot      46
##  5 Facility 2    2020-08-11 2020-08-12     North    Bolo     malaria_rd…      11
##  6 Facility 2    2020-08-11 2020-08-12     North    Bolo     malaria_rd…      10
##  7 Facility 2    2020-08-11 2020-08-12     North    Bolo     malaria_rd…       5
##  8 Facility 2    2020-08-11 2020-08-12     North    Bolo     malaria_tot      26
##  9 Facility 3    2020-08-11 2020-08-12     North    Dingo    malaria_rd…       8
## 10 Facility 3    2020-08-11 2020-08-12     North    Dingo    malaria_rd…       5
## # … with 12,142 more rows, and abbreviated variable name ¹​cases_reported

これでデータの準備は終了しました!これで、「テスト用の R スクリプト」の項目 1、2、3 を終えたことになります。最後の、そして最も難しいタスクが、ユーザーが指定したパラメータを利用して流行曲線(エピカーブ)を描画する関数作成です。以前にもお伝えしたように、shiny を学ぶ全ての人が関数型プログラミングのセクション(関数の作成)を一読して、関数の仕組みを理解しておくことを強く推奨します

関数を定義する際に、どのパラメータを含めればよいか考えることは難しいかもしれません。shiny における関数型プログラミングでは、通常、全てのパラメータに対応したウィジェットが存在するので、パラメータの選択はすごく簡単です!現在取り組んでいるアプリを例にすると、地区分類でデータを絞り込めるようにしたいので、そのためのウィジェットを用意し、地区のパラメータを加え、絞り込み操作をアプリに実装しましょう。施設で絞り込む機能は(現状では)ないので、施設をパラメータとして追加する必要はありません。次の 3 つのパラメータを含む関数を作るところからはじめましょう!

  1. 基となるデータセット
  2. 選ばれた地区
  3. 選ばれた年齢区分
plot_epicurve <- function(data, district = "All", agegroup = "malaria_tot") {
  
  if (!("All" %in% district)) {
    data <- data %>%
      filter(District %in% district)
    
    plot_title_district <- stringr::str_glue("{paste0(district, collapse = ', ')} districts")
    
  } else {
    
    plot_title_district <- "all districts"
    
  }
  
  # データが残っていなければ NULL を返す
  if (nrow(data) == 0) {
    
    return(NULL)
  }
  
  data <- data %>%
    filter(age_group == agegroup)
  
  
  # データが残っていなければ NULL を返す
  if (nrow(data) == 0) {
    
    return(NULL)
  }
  
  if (agegroup == "malaria_tot") {
      agegroup_title <- "All ages"
  } else {
    agegroup_title <- stringr::str_glue("{str_remove(agegroup, 'malaria_rdt')} years")
  }
  
  
  ggplot(data, aes(x = data_date, y = cases_reported)) +
    geom_col(width = 1, fill = "darkred") +
    theme_minimal() +
    labs(
      x = "date",
      y = "number of cases",
      title = stringr::str_glue("Malaria cases - {plot_title_district}"),
      subtitle = agegroup_title
    )
  
  
  
}

上記の関数の処理は比較的単純なため、関数の詳細な解説には踏み込みません。一点だけ注意することとしては、エラーを発生させないために NULL を返すことで対応しているということです。これは、shiny サーバーロジック関数がグラフオブジェクトではなくて NULL オブジェクトを生成すると UI には何も表示されないからです!この処理を行わなければアプリは頻繁に動きを止めてしまうため、この処理を入れることは大切です。

追加で注意するべき点としては、district(地区選択)の入力を評価する場合の%in% 演算子の利用です。前述の通り、地区選択の入力は複数の値を含む文字型ベクトルとなる可能性があります。そのため、%in% 演算子の方が、== 演算子より柔軟に対応できます。

それでは、関数をテストしてみましょう!

plot_epicurve(malaria_data, district = "Bolo", agegroup = "malaria_rdt_0-4")

関数がうまく動作した後は、関数で実現した機能がどのようにして shiny アプリに組み込まれていくのかを理解する必要があります。「スタートアップコード」(訳者注:サーバーロジック関数の外にコードをおいて実行を1回だけに制限する)の概念を前述しました。この概念をここではどのように実際にアプリに組み込むのかを見ていきましょう。スタートアップコードを実装する方法は二通りあります!

  1. スタートアップコードをapp.Rファイルの一番最初(UI の前)に記述する、か
  2. アプリのディレクトリに global.R という名前の新しいファイルをおいて、スタートアップコードをそのファイルの中に記述する

特筆すべき点としては、一般的に大規模なアプリでは 2 番目の方法をとると管理がよりかんたんになります。2 番目の方法は、簡単にファイル構造をシンプルな方法で分割することができるからです。それでは、ここでは global.R スクリプトを完成させてみましょう。次のような形になるはずです:

# global.R スクリプト

pacman::p_load("tidyverse", "lubridate", "shiny")

# データの読み込み
malaria_data <- rio::import(here::here("data", "malaria_facility_count_data.rds")) %>% 
  as_tibble()

# データを前処理し縦持ちデータへ変換する
malaria_data <- malaria_data %>%
  select(-newid) %>%
  pivot_longer(cols = starts_with("malaria_"), names_to = "age_group", values_to = "cases_reported")


# グラフ描画をする関数を定義する
plot_epicurve <- function(data, district = "All", agegroup = "malaria_tot") {
  
  # グラフのタイトルを作成する
  if (!("All" %in% district)) {            
    data <- data %>%
      filter(District %in% district)
    
    plot_title_district <- stringr::str_glue("{paste0(district, collapse = ', ')} districts")
    
  } else {
    
    plot_title_district <- "all districts"
    
  }
  
  # データが残っていなければNULLを返す
  if (nrow(data) == 0) {
    
    return(NULL)
  }
  
  # 年齢群で抽出する
  data <- data %>%
    filter(age_group == agegroup)
  
  
  # データが残っていなければNULLを返す
  if (nrow(data) == 0) {
    
    return(NULL)
  }
  
  if (agegroup == "malaria_tot") {
      agegroup_title <- "All ages"
  } else {
    agegroup_title <- stringr::str_glue("{str_remove(agegroup, 'malaria_rdt')} years")
  }
  
  
  ggplot(data, aes(x = data_date, y = cases_reported)) +
    geom_col(width = 1, fill = "darkred") +
    theme_minimal() +
    labs(
      x = "date",
      y = "number of cases",
      title = stringr::str_glue("Malaria cases - {plot_title_district}"),
      subtitle = agegroup_title
    )
  
  
  
}

簡単ですね!shiny の良い点の 1 つは、app.Rservver.Rui.Rglobal.Rと名前がついたファイルを認識してくれることです。そのため、これらのファイルを紐付けるためのコードを一切書く必要がありません。上記のコードを global.R に直接記載しておくだけで、アプリの開始時に自動的に実行されます!

また、アプリの構成はグラフの描画をする関数を別の独自のファイルに移動させると改善します。これは、アプリが大規模になると非常に役立ちます。関数を別のファイルに分けるには、funcs という名前の別のディレクトリを作成して plot_epicurve.R という名前のファイルを作成してそこに関数を保存します。その後、global.R から次のコードを利用して関数を読み込みましょう。

source(here("funcs", "plot_epicurve.R"), local = TRUE)

注:shiny アプリでは常に local = TRUE と設定しなくてはなりません。なぜなら、サーバーマシン上にアプリを公開した際 source() 関数の動作に影響を及ぼすからです。

43.5 アプリのサーバーロジック関数を作成する

大半のコードが出来上がったので、残りはサーバーロジック関数を作るだけです。この関数はアプリの最後のパーツです。そして最も理解することが難しいでしょう。サーバーロジック関数は大規模な R の関数ですが、小さな関数の集合、あるいは、アプリの機能の集合体であると考えると理解しやすいかもしれません。サーバーロジック関数に含まれる関数が第 1 行から順番に実行されるわけではないということを理解することが大切です。それら関数群には実行される順番はありますが、shiny アプリにおいていつ実行が開始されるかを完全に理解する必要はありません。とても基本的な理解としては、タスクあるいは関数は、開発者が特別にデフォルトと異なる設定を行った状況を除き、それら関数に影響を与えるインプットオブジェクトに何か変更が加えられた時に動き始めます。繰り返しになりますが、この説明は非常に抽象的ですが、とりあえず基本的な 3つの shiny オブジェクトを解説していきましょう。

  1. リアクティブソース - これはユーザーインプットの別の呼び方です。shiny サーバーロジック関数は作成したウィジェットを通じて ui オブジェクト内の出力値を受け取ることができます。ui オブジェクトの値が変更されるたびに、変更された値がサーバーロジック関数に渡されます。

  2. リアクティブコンダクター - これは shiny サーバーロジック関数の中にのみ定義される関数です。単純なアプリでは必要ではありませんが、サーバーロジック関数内のみで参照可能な他の処理で利用されるオブジェクトを作成します。一般的にはリアクティブコンダクターはリアクティブソース(textInput や sliderInput など)に依存します。

  3. エンドポイント - これはサーバーロジック関数から ui オブジェクトに渡されるアウトプットオブジェクトです。この章で作成しているアプリの例では、流行曲線(エピカーブ)が該当します。

これらのオブジェクトを念頭に置いて、サーバーロジック関数を順番に作成していきましょう。参考のためにもう一度 ui オブジェクトのコードを表示しておきます:

ui <- fluidPage(

  titlePanel("Malaria facility visualisation app"),

  sidebarLayout(

    sidebarPanel(
         # 地区の選択用インプットウィジェット
         selectInput(
              inputId = "select_district",
              label = "Select district",
              choices = c(
                   "All",
                   "Spring",
                   "Bolo",
                   "Dingo",
                   "Barnard"
              ),
              selected = "All",
              multiple = TRUE
         ),
         # 年齢の選択用インプットウィジェット
         selectInput(
              inputId = "select_agegroup",
              label = "Select age group",
              choices = c(
                   "All ages" = "malaria_tot",
                   "0-4 yrs" = "malaria_rdt_0-4",
                   "5-14 yrs" = "malaria_rdt_5-14",
                   "15+ yrs" = "malaria_rdt_15"
              ), 
              selected = "All",
              multiple = FALSE
         )

    ),

    mainPanel(
      # 流行曲線(エピカーブ)の描画
      plotOutput("malaria_epicurve")
    )
    
  )
)

この ui オブジェクトのコードは次のものを含みます:

  • インプットオブジェクト 2 つ:
    • 地区の選択用インプットウィジェット(select_district という inputId)
    • 年齢の選択用インプットウィジェット(select_agegroupという inputId)
  • アウトプットオブジェクト 1 つ:
    • 流行曲線(エピカーブ)(malaria_epicurveというoutputId)

以前ものべたように、インプットオブジェクトとアウトプットオブジェクトに設定したユニークな(重複がない)名前(inputId と outputId)が欠かせません。これらは、ユニークである必要があり、ui オブジェクトとサーバーロジック関数の間の情報のやり取りに利用されます。サーバーロジック関数の中では、input$inputID という構文でインプットオブジェクトを参照することができ、output$outputID という構文にアウトプットオブジェクトに出力を渡すことができます。このことを理解することは難しいので、まずは例を見てみましょう!

server <- function(input, output, session) {
  
  output$malaria_epicurve <- renderPlot(
    plot_epicurve(malaria_data, district = input$select_district, agegroup = input$select_agegroup)
  )
  
}

今回のような単純なアプリのサーバーロジック関数の内容は非常にわかりやすいです!サーバーロジック関数は 3 つの引数 - inputoutputsession をもつ関数であることに気づくでしょう -(現時点ではこれらの引数そのものについて理解することはそれほど重要ではありませんが、これらを関数の引数として設定することは大切です!)今回のサーバーロジック関数のタスクは 1 つしかありません。そのタスクとは、サーバーロジック関数の input 引数を先に作成したグラフ描画関数に渡してグラフを描画することです。インプットオブジェクトとアウトプットオブジェクトの名前が ui オブジェクトで設定した名前と完全に一致していることに注意してください。

サーバーロジック関数がユーザーの入力をどのように反映するかの基本を理解するためには、以下に注意してくだい。インプットオブジェクトの変化をアウトプットオブジェクトは(基礎となる shiny パッケージを通じて)認識します。アウトプットオブジェクトはインプットオブジェクトが変化するたびに、サーバーロジック関数を再実行しグラフを作成します。上記コードでは、renderPlot() 関数も使用していることに注意してください。この関数は、グラフオブジェクトを ui オブジェクトのアウトプット関数に渡す型指定関数群の 1 種です。似たような動作をする関数はいくつかありますが、使用する関数が ui オブジェクトに渡すオブジェクトの型と一致していることを確認する必要があります。例えば:

  • renderText() - ui オブジェクトにテキストを送る
  • renderDataTable - ui オブジェクトに動的なテーブルを送る。

これらは、UI で使用されるアウトプット関数と一致する必要があることを覚えておいてください。つまり、renderPlot()plotOutput() と対になり、renderText()textOutput() と対になります。

やっとちゃんと機能するアプリをつくることができました! Rstudio のスクリプトウィンドウの右上にある Run App ボタンを押して実行することができます。 また、アプリを(Rstudio ではなく)デフォルトのブラウザで実行するように選択することもできます。ブラウザで実行することで他の人にどのように見えるかがより正確に反映されます。

R コンソールでは、アプリが「反応を待っている」状態になっているのが楽しいですね。なにか入力してみましょう!

43.6 もっと沢山の機能を追加する

この時点で、ようやくアプリが動き出しましたが、機能はほとんどありません。また、shiny ができることのほんの一部しか知ることができていません。まだまだ学ぶことはたくさんあります!このアプリに、さらに機能を追加していきましょう。追加すると良い機能は次のようなものです:

  1. いくつかの説明文
  2. グラフをダウンロードするためのボタン - これにより、ユーザーにアプリで生成した画像の高画質版を提供します
  3. 特定の施設を指定できるインプットウィジェット
  4. ダッシュボードの追加ページ - ここにはデータの表を掲載しましょう

追加することはたくさんありますが、これを通して shiny の様々な機能を学ぶことができます。shiny について学ぶことは本当に沢山あります(shiny アプリは非常に高度なものになる可能性もありますが、アプリ開発者がパッケージの使い方について理解を深めれば、より快適に外部の学習ソースを使用できるようになると期待しています。).

静的なテキストの追加

まず、shiny アプリに静的なテキストを追加することについて考えましょう。基本的な知識を一度身につければ、アプリに静的なテキストを追加することはものすごく簡単です。静的なテキストは shiny アプリの中で変化しないため、一般的には静的なテキストはアプリの UI に記載されます(もし、テキストの内容を変化させたければ、テキストレンダリング関数をサーバーロジック関数内で利用しましょう)。ここでは詳しく説明しませんが、R を HTMLcss と連携させることで、UI に様々な要素を追加することができます(カスタム要素の追加も可能です)。

HTML や css は、ユーザーインターフェイスのデザインに明示的に関わる言語です。これらを深く理解する必要はありませんが、HTML は UI のオブジェクト(テキストボックスやテーブルなど)を作成し、css は一般的にそれらのオブジェクトのスタイルや見た目を変更するために使用されます。shiny は膨大な数の HTML タグにアクセスできます。これらは、ヘッダー、テキストの段落、改行、テーブルなど、特定の方法で振る舞うオブジェクトとして存在します。これらは、次のように利用できます:

  • h1() - これは見出しのタグです。これにより囲まれたテキストが自動的に大きくなり、フォントフェイスや色などのデフォルトが変更されます(アプリの全体的なテーマに応じて変更されます)。h2()から h6()までどんどん副見出しを小さくしていくこともできます。使用例は下記です:

    • h1("ヘッダー - セクション 1")
  • p() - これは、段落のタグです。これは、囲まれたテキストを、テキスト本文と同様にするものです。このテキストは自動的に折り返され、比較的小さなサイズで表示されます(フッターは、もっと小さいかもしれません)。word 文書のテキスト本文のようなものだと思ってください。使用例は下記:

    • p("これは、私が自分のアプリの機能を説明するためのテキストです。")
  • tags$b()tags$i() - これらはテキストが中に記載された場合に、太字 tags$b() や斜体 tags$i() で表現されます。

  • tags\(ul()`、`tags\)ol()tags\(li()` - これらは、<u>リスト</u>を作成する際に使用されるタグです。 これらはすべて以下の構文で使用され、ユーザーは順序付きのリスト(`tags\)ol(); 数字がふられている)か、順序なしのリスト(tags\(ul()`、中点がつけられている)を作成できます。tags\)li()`は、どちらのタイプのリストであっても、リスト内の項目を表すのに使われます。 例:

tags$ol(
  
  tags$li("Item 1"),
  
  tags$li("Item 2"),
  
  tags$li("Item 3")
  
)
  • br()hr() - これらのタグは、改行水平線 (改行あり)を作成します。アプリやテキストのセクションを区切るのに使いましょう!これらのタグにアイテムを渡す必要はありません(括弧は空のままでかまいません)。

  • div() -これは、何でも含むことができる汎用のタグで、好きな名前にすることができます。UI の設計が進むと、これらを利用して UI を区分けしたり、特定のセクションに特定のスタイルを与えたり、サーバーと UI 要素の間に相互作用を持たせたりすることができます。 詳細は省きますが、知っておいて損はありません!

なお、これらのオブジェクトはすべて、tags$... でアクセスできますし、いくつかは関数として呼び出すだけでアクセスできるものもあります。両者は事実上、同じ挙動ですが、誤って関数を上書きしないようにしたい場合には、より明確に tags$... スタイルを使用するとよいでしょう。また、これは利用可能なタグのすべてを網羅しているわけではありません。shiny で利用可能なすべてのタグの完全なリストは ここにあり、また、HTML を直接 UI に挿入することで、さらに多くのタグを利用することもできます!

自信のある方は、HTMLタグの style 引数に、任意の css スタイリング要素を追加することもできます。この仕組みについては詳しく説明しませんが、UI の視覚的特性をテストするためのヒントとして、chrome(あるいは、ブラウザで実行している shiny アプリ)の HTML インスペクタモードを使用して、オブジェクトのスタイルを自分で編集するという方法があります!

アプリにテキストを追加してみましょう

ui <- fluidPage(

  titlePanel("Malaria facility visualisation app"),

  sidebarLayout(

    sidebarPanel(
         h4("Options"),
         # 地域の選択用インプットウィジェット
         selectInput(
              inputId = "select_district",
              label = "Select district",
              choices = c(
                   "All",
                   "Spring",
                   "Bolo",
                   "Dingo",
                   "Barnard"
              ),
              selected = "All",
              multiple = TRUE
         ),
         # 年齢の選択用インプットウィジェット
         selectInput(
              inputId = "select_agegroup",
              label = "Select age group",
              choices = c(
                   "All ages" = "malaria_tot",
                   "0-4 yrs" = "malaria_rdt_0-4",
                   "5-14 yrs" = "malaria_rdt_5-14",
                   "15+ yrs" = "malaria_rdt_15"
              ), 
              selected = "All",
              multiple = FALSE
         ),
    ),

    mainPanel(
      # 流行曲線(エピカーブ)の描画
      plotOutput("malaria_epicurve"),
      br(),
      hr(),
      p("Welcome to the malaria facility visualisation app! To use this app, manipulate the widgets on the side to change the epidemic curve according to your preferences! To download a high quality image of the plot you've created, you can also download it with the download button. To see the raw data, use the raw data tab for an interactive form of the table. The data dictionary is as follows:"),
    tags$ul(
      tags$li(tags$b("location_name"), " - the facility that the data were collected at"),
      tags$li(tags$b("data_date"), " - the date the data were collected at"),
      tags$li(tags$b("submitted_daate"), " - the date the data were submitted at"),
      tags$li(tags$b("Province"), " - the province the data were collected at (all 'North' for this dataset)"),
      tags$li(tags$b("District"), " - the district the data were collected at"),
      tags$li(tags$b("age_group"), " - the age group the data were collected for (0-5, 5-14, 15+, and all ages)"),
      tags$li(tags$b("cases_reported"), " - the number of cases reported for the facility/age group on the given date")
    )
    
  )
)
)

リンクの追加

ハイパーリンクを貼るには、tags$a() に URL リンクとリンクテキストを入れて、以下のように使います。独立した段落を表示するにはp()の中に記載します。文章中の語句をハイパーリンクとして表示させたい場合は、ハイパーリンクとなる部分に tags$a() を使用します。ハイパーリンクを新しいブラウザウィンドウで開くようにするには、引数として target = "_blank" を追加してください。

tags$a(href = "www.epiRhandbook.com", "Visit our website!")

ダウンロードボタンを追加する

それでは、3つの機能のうち2つ目の機能を紹介しましょう。ダウンロードボタンは、アプリに追加するものとしてはかなり一般的なもので、簡単に作ることができます。ui オブジェクトに別のインプットウィジェットを追加し、サーバーロジック関数に別のアウトプットオブジェクトを追加してウィジェットと結合する必要があります。また、この例では、リアクティブコンダクターを追加します。

まずは ui オブジェクトを更新しましょう。shiny には downloadButton() というウィジェット関数があるためこの作業は簡単です。このウィジェット関数に inputId とラベルを追加しましょう。

ui <- fluidPage(

  titlePanel("Malaria facility visualisation app"),

  sidebarLayout(

    sidebarPanel(
         # 地域の選択用インプットウィジェット
         selectInput(
              inputId = "select_district",
              label = "Select district",
              choices = c(
                   "All",
                   "Spring",
                   "Bolo",
                   "Dingo",
                   "Barnard"
              ),
              selected = "All",
              multiple = FALSE
         ),
         # 年齢の選択用インプットウィジェット
         selectInput(
              inputId = "select_agegroup",
              label = "Select age group",
              choices = c(
                   "All ages" = "malaria_tot",
                   "0-4 yrs" = "malaria_rdt_0-4",
                   "5-14 yrs" = "malaria_rdt_5-14",
                   "15+ yrs" = "malaria_rdt_15"
              ), 
              selected = "All",
              multiple = FALSE
         ),
         # 水平線
         hr(),
         downloadButton(
           outputId = "download_epicurve",
           label = "Download plot"
         )

    ),

    mainPanel(
      # 流行曲線(エピカーブ)の描画
      plotOutput("malaria_epicurve"),
      br(),
      hr(),
      p("Welcome to the malaria facility visualisation app! To use this app, manipulate the widgets on the side to change the epidemic curve according to your preferences! To download a high quality image of the plot you've created, you can also download it with the download button. To see the raw data, use the raw data tab for an interactive form of the table. The data dictionary is as follows:"),
      tags$ul(
        tags$li(tags$b("location_name"), " - the facility that the data were collected at"),
        tags$li(tags$b("data_date"), " - the date the data were collected at"),
        tags$li(tags$b("submitted_daate"), " - the date the data were submitted at"),
        tags$li(tags$b("Province"), " - the province the data were collected at (all 'North' for this dataset)"),
        tags$li(tags$b("District"), " - the district the data were collected at"),
        tags$li(tags$b("age_group"), " - the age group the data were collected for (0-5, 5-14, 15+, and all ages)"),
        tags$li(tags$b("cases_reported"), " - the number of cases reported for the facility/age group on the given date")
      )
      
    )
    
  )
)

hr() タグを追加したことに注意してください。これは、ダウンロードウィジェットと入力値を操作するウィジェットの間に水平線を追加します。このタグも、先に紹介した HTML タグの 1 つです。

ui オブジェクトが準備できたので、サーバーロジック関数に要素を追加しなければなりません。ダウンロードは、サーバーロジック関数内の downloadHandler() 関数を利用して行われます。グラフの出力と同様に、ダウンロードボタンと同じ inputId をもつアウトプットオブジェクトに割り当てなければなりません。この関数は引数を 2 つ必要とします。filenamecontent です。これら 2 つとも関数として指定します。推測することが可能かもしれませんが、filename はダウンロードするファイルの名前を指定し、content は何をダウンロードするかを指定します。content はローカル環境に保存するデータを含みます。そのため、csv ファイルをダウンロードする場合は、rio::export() を利用します。ここでは、グラフをダウンロードするので、ggplot2::ggsave()を利用します。これをどのように実装するか見ていきましょう(サーバーロジック関数にはまだ追加しません)。

server <- function(input, output, session) {
  
  output$malaria_epicurve <- renderPlot(
    plot_epicurve(malaria_data, district = input$select_district, agegroup = input$select_agegroup)
  )
  
  output$download_epicurve <- downloadHandler(
    filename = function() {
      stringr::str_glue("malaria_epicurve_{input$select_district}.png")
    },
    
    content = function(file) {
      ggsave(file, 
             plot_epicurve(malaria_data, district = input$select_district, agegroup = input$select_agegroup),
             width = 8, height = 5, dpi = 300)
    }
    
  )
  
}

なお、content 関数は常に file という引数を取り、出力するファイルを指定された場所に保存します。また、上記コード内では重複があることに気づいたかもしれません。plot_epicurve() 関数をサーバーロジック関数内で、ダウンロードのためと描画のために 2 回利用しています。このことはアプリのパフォーマンスを劇的に低下させるようなことはありませんが、ユーザーが地区と年齢の設定をインプットウィジェットから変更した場合、および、プロットをダウンロードをした場合にコードが実行されてしまいます。大規模なアプリでは、このような最適されていないコードが繰り返されることで、ますますアプリ全体が重くなっていきます。そのため、パフォーマンスの観点からアプリをより効率化する方法を学んでおくことが推奨されます。効率化する方法をより理解しやすく言い換えるとすると、地区/年齢が変更されたときに流行曲線(エピカーブ)を描画するコードを実行させて、 renderPlot() と downloadHandler() 関数にその結果を利用させるということです。ここで、リアクティブコンダクターが登場します!

リアクティブコンダクターは shiny サーバーロジック関数内にありユーザインプットに対応して反応的に生成される、出力はされないオブジェクトです。サーバーロジック関数内の別の部分で利用されるだけです。リアクティブコンダクターには沢山の種類がありますが、ここでは、基本となる 2 種類だけを見ていきます。

1.reactive() - これが最も基本的なリアクティブコンダクターです。内部で使用されるインプットオブジェクトが変更されるたびに反応します(今作成しているアプリでの例では地区/年齢を指定するインプットウィジェットです)。
2. eventReactive()- これは reactive() と同様な機能をもつリアクティブコンダクターです。違う点は、どのインプットオブジェクトがこのリアクティブコンダクターを反応させるかをユーザが指定できるという点です。これは、リアクティブコンダクターの処理に時間がかかるような場合に便利ですが、後で詳しく説明します。

2 つの例をみてみましょう:

malaria_plot_r <- reactive({
  
  plot_epicurve(malaria_data, district = input$select_district, agegroup = input$select_agegroup)
  
})


# 地区の選択が変更されたときにのみ実行
malaria_plot_er <- eventReactive(input$select_district, {
  
  plot_epicurve(malaria_data, district = input$select_district, agegroup = input$select_agegroup)
  
})

eventReactive() を使う場合、どのインプットオブジェクトがこの関数内のコードを実行させるかを指定できます。今の状況ではそれほど便利ではないので、置いておきましょう。注:c() を利用して複数のインプットオブジェクトを指定することもできます。

この機能をサーバーロジック関数内に組み込む方法を見てみましょう:

server <- function(input, output, session) {
  
  malaria_plot <- reactive({
    plot_epicurve(malaria_data, district = input$select_district, agegroup = input$select_agegroup)
  })
  
  
  
  output$malaria_epicurve <- renderPlot(
    malaria_plot()
  )
  
  output$download_epicurve <- downloadHandler(
    
    filename = function() {
      stringr::str_glue("malaria_epicurve_{input$select_district}.png")
    },
    
    content = function(file) {
      ggsave(file, 
             malaria_plot(),
             width = 8, height = 5, dpi = 300)
    }
    
  )
  
}

ダウンロード関数とプロットレンダリング関数の両方で reactive 関数で定義したアウトプットオブジェクトを呼び出しているだけであることがわかります。注意しなければならない、多くの人が引っかかるのが、 reactive 関数のアウトプットオブジェクトの使い方で、関数のように利用しなければならないということです。呼び出すには、空のカッコを最後につけることが必須です(例:malaria_plot()は正しく、malaria_plot は間違いです)。この部分を追加したことで、アプリは少し整理され、速くなり、epicurve 関数を実行するすべてのコードが 1 つの場所にあるため、変更も容易になりました。

施設の選択を追加する

次の機能に進みましょう。施設を選択するためのセレクターウィジェットの追加です。plot_epicurve 関数が、施設を選択した結果を受け取ることができるように、別の引数をとれるように実装していきます。これは、他の引数で実装したことを繰り返せばよいです。コードを更新して、テストしてみましょう。

plot_epicurve <- function(data, district = "All", agegroup = "malaria_tot", facility = "All") {
  
  if (!("All" %in% district)) {
    data <- data %>%
      filter(District %in% district)
    
    plot_title_district <- stringr::str_glue("{paste0(district, collapse = ', ')} districts")
    
  } else {
    
    plot_title_district <- "all districts"
    
  }
  
  # データが残っていなければNULLを返す
  if (nrow(data) == 0) {
    
    return(NULL)
  }
  
  data <- data %>%
    filter(age_group == agegroup)
  
  
  # データが残っていなければNULLを返す
  if (nrow(data) == 0) {
    
    return(NULL)
  }
  
  if (agegroup == "malaria_tot") {
      agegroup_title <- "All ages"
  } else {
    agegroup_title <- stringr::str_glue("{str_remove(agegroup, 'malaria_rdt')} years")
  }
  
    if (!("All" %in% facility)) {
    data <- data %>%
      filter(location_name == facility)
    
    plot_title_facility <- facility
    
  } else {
    
    plot_title_facility <- "all facilities"
    
  }
  
  # データが残っていなければNULLを返す
  if (nrow(data) == 0) {
    
    return(NULL)
  }

  
  
  ggplot(data, aes(x = data_date, y = cases_reported)) +
    geom_col(width = 1, fill = "darkred") +
    theme_minimal() +
    labs(
      x = "date",
      y = "number of cases",
      title = stringr::str_glue("Malaria cases - {plot_title_district}; {plot_title_facility}"),
      subtitle = agegroup_title
    )
  
  
  
}

試して見ましょう:

plot_epicurve(malaria_data, district = "Spring", agegroup = "malaria_rdt_0-4", facility = "Facility 1")

全ての施設がデータに含まれているため、どの地区にどの施設が含まれているかは明確ではなく、エンドユーザーにも同様にもわかりません。これでは、アプリの使い勝手が悪くなってしまうかもしれません。そのため、エンドユーザーが地区を選択すると、施設の UI の内容が動的に変化するようにするべきです!ウィジェット関数のオプションで使用する変数が多いので、global.R ファイルで ui オブジェクト内のオプションの一部をデータから生成することもできます。例えば、次のようなコードを global.R ファイルのデータ読み込み箇所の後に追加してもよいでしよう:

all_districts <- c("All", unique(malaria_data$District))

# 地区毎の施設名
facility_list <- malaria_data %>%
  group_by(location_name, District) %>%
  summarise() %>% 
  ungroup()

変数の内容を確認してみましょう:

all_districts
## [1] "All"     "Spring"  "Bolo"    "Dingo"   "Barnard"
facility_list
## # A tibble: 65 × 2
##    location_name District
##    <chr>         <chr>   
##  1 Facility 1    Spring  
##  2 Facility 10   Bolo    
##  3 Facility 11   Spring  
##  4 Facility 12   Dingo   
##  5 Facility 13   Bolo    
##  6 Facility 14   Dingo   
##  7 Facility 15   Barnard 
##  8 Facility 16   Barnard 
##  9 Facility 17   Barnard 
## 10 Facility 18   Bolo    
## # … with 55 more rows

この新しい変数は、サーバーロジック関数と ui オブジェクトから見える状態となっているため、ui オブジェクトに特に問題なく渡すことができます。UI も更新しておきましょう:

ui <- fluidPage(

  titlePanel("Malaria facility visualisation app"),

  sidebarLayout(

    sidebarPanel(
         # 地区の選択用インプットウィジェット
         selectInput(
              inputId = "select_district",
              label = "Select district",
              choices = all_districts,
              selected = "All",
              multiple = FALSE
         ),
         # 年齢の選択用インプットウィジェット
         selectInput(
              inputId = "select_agegroup",
              label = "Select age group",
              choices = c(
                   "All ages" = "malaria_tot",
                   "0-4 yrs" = "malaria_rdt_0-4",
                   "5-14 yrs" = "malaria_rdt_5-14",
                   "15+ yrs" = "malaria_rdt_15"
              ), 
              selected = "All",
              multiple = FALSE
         ),
         # 施設の選択用インプットウィジェット
         selectInput(
           inputId = "select_facility",
           label = "Select Facility",
           choices = c("All", facility_list$location_name),
           selected = "All"
         ),
         
         # 水平線
         hr(),
         downloadButton(
           outputId = "download_epicurve",
           label = "Download plot"
         )

    ),

    mainPanel(
      # 流行曲線(エピカーブ)の表示
      plotOutput("malaria_epicurve"),
      br(),
      hr(),
      p("Welcome to the malaria facility visualisation app! To use this app, manipulate the widgets on the side to change the epidemic curve according to your preferences! To download a high quality image of the plot you've created, you can also download it with the download button. To see the raw data, use the raw data tab for an interactive form of the table. The data dictionary is as follows:"),
      tags$ul(
        tags$li(tags$b("location_name"), " - the facility that the data were collected at"),
        tags$li(tags$b("data_date"), " - the date the data were collected at"),
        tags$li(tags$b("submitted_daate"), " - the date the data were submitted at"),
        tags$li(tags$b("Province"), " - the province the data were collected at (all 'North' for this dataset)"),
        tags$li(tags$b("District"), " - the district the data were collected at"),
        tags$li(tags$b("age_group"), " - the age group the data were collected for (0-5, 5-14, 15+, and all ages)"),
        tags$li(tags$b("cases_reported"), " - the number of cases reported for the facility/age group on the given date")
      )
      
    )
    
  )
)

選択肢を ui オブジェクトの中に直接記載(ハードコーディング)するのではなく、変数を利用して指定していることに注目してください。これにより、コードもよりコンパクトになる可能性があります。最後に、サーバーロジック関数を更新しましょう。新しいインプットオブジェクトを組み込むように関数を更新するのは簡単ですが(新しい引数として渡すだけです)、ユーザーが選択した地区を変更したときに UI を動的に更新することも忘れてはなりません。ここで理解していただきたいのは、アプリの実行中にウィジェットのインプットオブジェクトの値や動作を更新することはできますが、この更新のためのコードはサーバーロジック関数の中で実行する必要があります。この方法を学ぶためには、サーバーロジック関数に出力する新しい方法を理解する必要があります。

この方法を理解するために必要な関数は、observer 関数と呼ばれ、その振る舞いは reactive 関数と似ています。しかし、この 2 つには重要な違いが 1 つあります。

  • reactive 関数は出力に直接影響を与えず、サーバーロジック関数内の他の場所で呼び出すことができるオブジェクトを生成します
  • observer 関数は サーバーロジック関数のアウトプットオブジェクトに影響を与えることができますが、それは他の関数の副作用によって行われます(他のこともできますが、実際にはこれが主な機能です)

reactive 関数と同様に、observer 関数にも 2 つの種類があり、reacive 関数と同じ仕組みで分けられています。

  1. observe() - この関数は、内部で使用されているインプットオブジェクトが変化するたびに実行されます。
  2. observeEvent() - この関数は設定されたインプットオブジェクト が変化する度に実行されます。

shiny で提供されているインプットウィジェットを更新する関数についての理解も必要です。これらの関数は、かなり簡単に実行できます。サーバーロジック関数の session オブジェクト(今は理解できなくても問題ありません)を 1 つ目の引数としてとしてとり、2 つ目に変更したい ui オブジェクトの inputId をとります。 3 つ目に、更新する基となるウィジェット selectInput() 関数によってすでに取得されている選択肢すべてを持つ新規のインプットオブジェクトを渡します。以上により、ウィジェットは自動的に更新されます。

この機能をサーバーロジック関数内で使用する場合の例を見てみましょう。エンドユーザーが地区を変更した場合、施設の一覧を地区別に抽出し、選択肢をその地区で利用可能なものだけとするように更新します(すべての施設を選択することもできます)。

observe({
  
  if (input$select_district == "All") {
    new_choices <- facility_list$location_name
  } else {
    new_choices <- facility_list %>%
      filter(District == input$select_district) %>%
      pull(location_name)
  }
  
  new_choices <- c("All", new_choices)
  
  updateSelectInput(session, inputId = "select_facility",
                    choices = new_choices)
  
})

完成しました!上記コードをサーバーロジック関数内に足すと、動作します。新しいサーバーロジック関数は次のようになっているはずです:

server <- function(input, output, session) {
  
  malaria_plot <- reactive({
    plot_epicurve(malaria_data, district = input$select_district, agegroup = input$select_agegroup, facility = input$select_facility)
  })
  
  
  
  observe({
    
    if (input$select_district == "All") {
      new_choices <- facility_list$location_name
    } else {
      new_choices <- facility_list %>%
        filter(District == input$select_district) %>%
        pull(location_name)
    }
    
    new_choices <- c("All", new_choices)
    
    updateSelectInput(session, inputId = "select_facility",
                      choices = new_choices)
    
  })
  
  
  output$malaria_epicurve <- renderPlot(
    malaria_plot()
  )
  
  output$download_epicurve <- downloadHandler(
    
    filename = function() {
      stringr::str_glue("malaria_epicurve_{input$select_district}.png")
    },
    
    content = function(file) {
      ggsave(file, 
             malaria_plot(),
             width = 8, height = 5, dpi = 300)
    }
    
  )
  
  
  
}

表を含んだタブを追加する

次に、アプリに追加したい最後の要素に移りましょう。 アプリの UI を 2 つのタブに分割します。1 つのタブには流行曲線(エピカーブ)を描画しているデータを動的に確認することができる表を挿入します。そのためには、shiny に付属するパッケージ化されたタブに関連した UI 要素を利用します。基本的には、下記の一般的な UI 構造の中に、メインパネルのほとんどを収めることができます。

# ... は残りの ui オブジェクト部分を表す

mainPanel(
  
  tabsetPanel(
    type = "tabs",
    tabPanel(
      "Epidemic Curves",
      ...
    ),
    tabPanel(
      "Data",
      ...
    )
  )
)

この構造を今作成している ui オブジェクトに当てはめましょう。また、ここでは DT パッケージを使用します。 - これは、既存のデータから動的な表を作成するための素晴らしいパッケージです。この例では、DT::datatableOutput() で使用されているのを確認することができます。

ui <- fluidPage(
     
     titlePanel("Malaria facility visualisation app"),
     
     sidebarLayout(
          
          sidebarPanel(
               # 地区の選択用インプットウィジェット
               selectInput(
                    inputId = "select_district",
                    label = "Select district",
                    choices = all_districts,
                    selected = "All",
                    multiple = FALSE
               ),
               # 年齢の選択用インプットウィジェット
               selectInput(
                    inputId = "select_agegroup",
                    label = "Select age group",
                    choices = c(
                         "All ages" = "malaria_tot",
                         "0-4 yrs" = "malaria_rdt_0-4",
                         "5-14 yrs" = "malaria_rdt_5-14",
                         "15+ yrs" = "malaria_rdt_15"
                    ), 
                    selected = "All",
                    multiple = FALSE
               ),
               # 施設の選択用インプットウィジェット
               selectInput(
                    inputId = "select_facility",
                    label = "Select Facility",
                    choices = c("All", facility_list$location_name),
                    selected = "All"
               ),
               
               # 水平線
               hr(),
               downloadButton(
                    outputId = "download_epicurve",
                    label = "Download plot"
               )
               
          ),
          
          mainPanel(
               tabsetPanel(
                    type = "tabs",
                    tabPanel(
                         "Epidemic Curves",
                         plotOutput("malaria_epicurve")
                    ),
                    tabPanel(
                         "Data",
                         DT::dataTableOutput("raw_data")
                    )
               ),
               br(),
               hr(),
               p("Welcome to the malaria facility visualisation app! To use this app, manipulate the widgets on the side to change the epidemic curve according to your preferences! To download a high quality image of the plot you've created, you can also download it with the download button. To see the raw data, use the raw data tab for an interactive form of the table. The data dictionary is as follows:"),
               tags$ul(
                    tags$li(tags$b("location_name"), " - the facility that the data were collected at"),
                    tags$li(tags$b("data_date"), " - the date the data were collected at"),
                    tags$li(tags$b("submitted_daate"), " - the date the data were submitted at"),
                    tags$li(tags$b("Province"), " - the province the data were collected at (all 'North' for this dataset)"),
                    tags$li(tags$b("District"), " - the district the data were collected at"),
                    tags$li(tags$b("age_group"), " - the age group the data were collected for (0-5, 5-14, 15+, and all ages)"),
                    tags$li(tags$b("cases_reported"), " - the number of cases reported for the facility/age group on the given date")
               )
               
               
          )
     )
)

以上で、アプリにタブが追加されました!サーバーロジック関数にも必要な編集を加えてみましょう。表としてレンダリングする前にデータを加工する必要がないので、これは非常に簡単です。malaria_data データを DT::renderDT() 経由で ui オブジェクトに描画するだけです!

server <- function(input, output, session) {
  
  malaria_plot <- reactive({
    plot_epicurve(malaria_data, district = input$select_district, agegroup = input$select_agegroup, facility = input$select_facility)
  })
  
  
  
  observe({
    
    if (input$select_district == "All") {
      new_choices <- facility_list$location_name
    } else {
      new_choices <- facility_list %>%
        filter(District == input$select_district) %>%
        pull(location_name)
    }
    
    new_choices <- c("All", new_choices)
    
    updateSelectInput(session, inputId = "select_facility",
                      choices = new_choices)
    
  })
  
  
  output$malaria_epicurve <- renderPlot(
    malaria_plot()
  )
  
  output$download_epicurve <- downloadHandler(
    
    filename = function() {
      stringr::str_glue("malaria_epicurve_{input$select_district}.png")
    },
    
    content = function(file) {
      ggsave(file, 
             malaria_plot(),
             width = 8, height = 5, dpi = 300)
    }
    
  )
  
  # データテーブルを ui オブジェクトに描画する
  output$raw_data <- DT::renderDT(
    malaria_data
  )
  
  
}

43.7 shiny アプリの共有

アプリが完成したら、他の人と共有したいと思うこともあるでしょう。これが shiny の最大の利点です。そのためには、コードを直接共有することもできますし、サーバーマシン上で公開することもできます。コードを共有すれば、他の人があなたの実装した内容を見て、それに基づいてさらなる機能を構築することができますが、これは shiny の主な利点の1つを否定することになります。どういうことかというと、shiny は、エンドユーザーが R のインストールを行いメンテナンスする必要性をなくすことができます。このため、 R が苦手なユーザーとアプリを共有する場合は、サーバーマシン上で公開するアプリを共有する方がはるかに簡単です。

もし、コードを直接共有したいのであれば、アプリの .zip ファイルを作成するか、あるいは、github にアプリを公開して、協力者を追加することもできます。 詳細はこちらの github のセクションを参照してください。

しかし、アプリをオンラインで公開する場合は、もう少し作業が必要です。最終的には、あなたのアプリをウェブ URL からアクセスできるようにして、他の人が素早く簡単に到達できるようにしたいのです。残念ながら、アプリをサーバーマシン上で公開するには、公開するためのサーバーマシンが必要です!これに関しては、いくつかのホスティングするための選択肢があります。

  • shinyapps.io:ここは shiny アプリを公開するのに最も簡単な場所です。設定は最小限です。無料でも利用できますが、いくつかの制限があります。

  • RStudio Connect:これは、R サーバーのはるかに強力なバージョンで、shiny アプリの公開を含む多くの操作を行うことができます。しかし、使い方が難しく、初めての方にはあまりお勧めできません。

本書では、初めての方でも利用しやすいように、shinyapps.io を使用します。無料のアカウントを作成してスタートすることもできますし、また、必要に応じてサーバーライセンスの追加などの料金プランもあります。利用するユーザー数が増えれば増えるほど、料金プランも高額になる可能性があるため、ご注意ください。少人数が使用するアプリを作りたい場合は、無料のライセンスが最適かもしれませんが、一般公開するアプリの場合はより高額のライセンスが必要になるかもしれません。

まず、アプリがサーバーマシン上での公開に適していることを確認します。R セッションを再起動して、不要なコードが実行されずにアプリが起動することを確認してください。アプリのコードで定義されていないパッケージの読み込みやデータの読み取みをアプリが必要とする場合、サーバーマシン上では実行されないため、この確認は非常に重要です。また、アプリ内では明示的なファイルパスを使えないことにも注意してください。サーバーマシン上の環境で、ファイルパスはエラーの原因になります。here パッケージを使用することで、この問題は非常にうまく解決されます。最後に、会社のサーバーマシンなど、ユーザー認証を必要とするデータソースからデータを読み取る場合は、一般的にサーバーマシン上でアプリは動作しません。shiny サーバーをホワイトリストに登録する方法については、IT 部門と相談する必要があります。

アカウントへのサインアップ

アカウントを取得したら、Accounts 内にある tokens のページに移動します。このページでは、新しいトークンを追加します。トークンは、アプリのデプロイに使用されます。

ここからの作業で、アカウントのURLにアプリの名前が反映されることに注意してください。つまり、アプリの名前が「my app」であれば、URLは「xxx.io/my_app/」となります。アプリの名前は賢く選びましょう!全ての準備が完了です。deploy をクリックしましょう。成功していれば、選んだ URL でアプリが実行されているはずです。

このハンドブックでアプリ作成に関する何か?

43.8 参考資料

ここまでは、shiny の様々な側面を紹介してきましたが、shiny の機能の「さわり」に触れただけです。このガイドは入門編ですが、shiny を完全に理解するためには、さらに多くのことを学ぶ必要があります。アプリを作り始めて、徐々に機能を増やしていくのが良いでしょう。

43.9 推奨される機能拡張パッケージ

以下に、shiny の機能を拡張できる高品質なパッケージを集めました。順不同:

  • shinyWidgets - このパッケージは、アプリで使用できるウィジェットを多数追加します。shinyWidgets::shinyWidgetsGallery()を実行すると、このパッケージで利用可能なウィジェットのセレクションが表示されます。 例は ここにあります。

  • shinyjs - これは、javascript を利用することで shiny の実用性を大幅に向上させることができる優れたパッケージです。このパッケージの用途は非常にシンプルなものから高度なものまで様々ですが、まずは要素の非表示/表示、ボタンの有効化/無効化など、簡単な方法で UI を操作するために使ってみてはいかがでしょうか。ここにより沢山の例があります。

  • shinydashboard - このパッケージは、shiny で使用可能な UI を大幅に拡張し、特に、様々な複雑なレイアウトのダッシュボードを作成できるようにします。ここに詳細があります。

  • shinydashboardPlus - Shinydashboard フレームワークの機能をさらに充実させます! ここで詳しく内容を確認できます。

  • shinythemes - 豊富なプリセットテンプレートを利用して、shiny アプリのデフォルト css テーマを変更できます。 詳細はここ

shiny に対応した動的な出力を作成するために使用できるパッケージも多数あります。

  • DT は base-shiny に半統合されていますが、動的なテーブルを作成するための素晴らしい関数群を提供しています。

  • plotly は、ユーザーがアプリ内で操作できる動的なグラフを作成するためのパッケージです。 また、plotly::ggplotly() を使って、プロットを動的なバージョンに変換することもできます!dygraphshighcharter も同様に優れています。

43.10 推奨されるリソース