読者です 読者をやめる 読者になる 読者になる

ふんわり R-tips

ぜんぜんわからない、俺たちは雰囲気でRをやっている

rmarkdownを使った組み込みShinyアプリケーション

Shiny rmarkdown

このエントリは、RStudioのEmbedded Shiny Appsを抜粋・翻訳・追記したものです。

http://rmarkdown.rstudio.com/authoring_embedded_shiny.html

概要

rmarkdownで作成したドキュメントには、以下の2通りの方法でShinyアプリケーションを組み込むことができます。

  1. ShinyApp関数を用いてインラインアプリケーションを定義

  2. ShinyAppDir関数を用いて外部アプリケーションディレクトリを参照

ファイルの先頭に以下のYAMLを記述してRmdファイルを作成し、rmarkdownによる表示を行います。

---
runtime: shiny
output: html_document
---

インラインアプリケーション定義

インラインアプリケーションは、以下のコード例のように定義します。コード中のバックスラッシュは、バッククォートを表示させるために挿入しているので、取り除いてください。

\```{r, echo = FALSE}
shinyApp(
  
  ui = fluidPage(
    selectInput("region", "Region:", 
                choices = colnames(WorldPhones)),
    plotOutput("phonePlot")
  ),
  
  server = function(input, output) {
    output$phonePlot <- renderPlot({
      barplot(WorldPhones[,input$region]*1000, 
              ylab = "Number of Telephones", xlab = "Year")
    })
  },
  
  options = list(height = 500)
)
\```

パラメータheightで、組み込んだアプリケーションが占める縦のスペースの大きさを指定します。

外部アプリケーション参照

別のディレクトリに置いたShinyアプリケーションは、以下のコード例のように参照します。コード中のバックスラッシュは、バッククォートを表示させるために挿入しているので、取り除いてください。

\```{r, echo = FALSE}
shinyAppDir(
  system.file("examples/06_tabsets", package="shiny"),
  options=list(
    width="100%", height=700
  )
)
\```

いずれのRコードも、echo = FALSE属性を指定しています。この属性により、Rコードは、Shinyのコンポーネントと一緒にレンダリングされません。

実行例

f:id:phmpk:20170323201429p:plain

コードを実行すると、markdownによる記述の下側に、Shinyが埋め込まれます。

f:id:phmpk:20170323201515p:plain

ベルヌーイ分布と二項分布

R Marddownの説明で作成したRmdファイルを、はてなブログに投稿するエントリとして書き直しました。

r-tips.hatenablog.com

ベルヌーイ分布 (Bernoulli distribution) は、二値確率変数  x \in \{ 0,1 \} をとる離散分布です。

  • x=1 となる確率を \pi \quad (0 \leq \pi \leq 1)
  • x=0 となる確率を 1-\pi

とします。ベルヌーイ分布は、 \pi をパラメータとして、

 
{\rm Bernoulli} (x|\pi) \equiv \pi^x (1-\pi)^{1-x} \quad (x \in \{ 0,1 \})


で定義されます。ベルヌーイ分布に従う n 回の独立した試行を考えます。

  • x_i \in \{ 0,1 \} により、i 回目の試行を、
  • n_0 で0が出た回数を、
  • n_1 で1が出た回数を、

表すこととします。\pi が与えられたもとでの \boldsymbol{x} = { x_1,x_2, \cdots ,x_n } の確率は、


p(\boldsymbol{x} | \pi) = \prod^n_{i=1} p(x_i|\pi) = \pi^{n_1} (1-\pi)^{n_0}

と計算できます。

二項分布 (binomial distribution) \pin をパラメータとして、


{\rm Bi} (n_1 | \pi, n) \equiv \frac{n!}{{n_1}!(n-n_1)!} \pi^{n_1} (1-\pi)^{n-n_1}

で定義され、各試行における値ではなく、 n 回の試行における1の出現回数に興味がある場合に、 n_1\pin をパラメータとして表現します。

R で二項分布の確率密度を表現する関数dbinomを使って、二項分布のグラフを描きます。表と裏の出る確率が同じ0.5であるコインを投げて、表(裏)の出る回数が1~50になる確率をプロットします。

10回~50回投げたときのプロットの変化を重ね描きします。

par(ann=F)
plot(1:50,dbinom(1:50, 10, p=0.5),type="l",ylim=c(0,0.3),col=1)
par(new=T)
plot(1:50,dbinom(1:50, 20, p=0.5),type="l",ylim=c(0,0.3),col=2)
par(new=T)
plot(1:50,dbinom(1:50, 30, p=0.5),type="l",ylim=c(0,0.3),col=3)
par(new=T)
plot(1:50,dbinom(1:50, 40, p=0.5),type="l",ylim=c(0,0.3),col=4)
par(new=T)
plot(1:50,dbinom(1:50, 50, p=0.5),type="l",ylim=c(0,0.3),col=5)
grid()

f:id:phmpk:20170322193038p:plain

はてなブログではtex形式の数式が使えますが、そのまま$数式$[tex:数式]に変換してもうまく行きません。markdownの処理内で、mathjax処理を実行しているため、エスケープが完全にできていません。

R Markdownを導入して数式・グラフ・ソースコード付きのレポート作成

rmarkdown

はじめに

R Markdownを導入してレポートを作成する方法について述べます。すでに、R Markdown、pandocについて知っている人向けに、最短で環境を構築して書き始めるにはどうすればいいんだっけ?という質問への回答エントリになっています。詳しい説明は、まったくしない(できない)ので、読み進める方は注意して下さい。

インストール

  • Rのコンソールでinstall.packages(“rmarkdown”)を実行

  • pandocのインストール

インストールの確認

library(rmarkdown)
pandoc_available()

インストールされていれば、rmarkdownのパッケージ呼び出しでエラーが出ず、pandoc_available()[1] TRUEが返ってきます。

R Markdownファイル(*.Rmd)の作成

Rawファイルと変換後のhtmlファイルをGithubにアップロードしています。

github.com

上記の例では、bernoulli.Rmdとしてファイルを作成します。日本語はShift JISで保存します。UTF-8だと文字化けします。

R MarkdownからHTMLを生成

library(rmarkdonw)
render("bernoulli.Rmd")

pandocを使えば、さらにPDF, MS Word, Beamer, ioslides, reveal.jsに変換することもできます。

insertUIを用いた動的なShinyのユーザインタフェース

Shiny

このエントリでは、rstudio::conf 2017で紹介されたShinyのinsertUIを解説します。

https://github.com/bborgesr/rstudio-conf2017

githubで公開されたソースコード(03-insertUI.R)を引用しています。

Shinyアプリケーションでは、予めui.R、または (app.R中の) uiオブジェクトとして、固定のUIを配置する必要があります。固定ではなく動的なUIを実現するために、 renderUIを用いて、ui中にuiOutputで指定したコンポーネントを動的に表示することができます。renderUIは便利ですが、新たにコンポーネントを追加する場合には、uiOutputで確保したスロットに再度render関数による表示が必要となります。

これを回避して、より動的にコンポーネントの追加表示を行うのに使用するのがinsertUIです。

insertUIの使用例

実行例

初期状態ではメインパネルにコンポーネントがありません。

f:id:phmpk:20170307191847p:plain

datasetがrock、toolがsummaryの状態でボタンを押すと、データrockのsummaryがメインパネルに追加されます。

f:id:phmpk:20170307192019p:plain

次に、datasetがpressure、toolがplotの状態でボタンを押すと、データpressureのplotが、最初に追加したsummaryの下側に追加されます。

f:id:phmpk:20170307192038p:plain

次に、datasetがcars、toolがheadの状態でボタンを押すと、データcarsの表がplotの下側に追加されます。

f:id:phmpk:20170307192159p:plain

ソースコード

library(shiny)
library(datasets)

shinyApp(
  ui = fluidPage(
    titlePanel('Using insertUI'),
    sidebarLayout(
      sidebarPanel(
        selectInput('data', 'Choose a dataset', c('rock', 'pressure', 'cars')),
        radioButtons('tool', 'Choose a tool', c('summary', 'plot', 'head')),
        actionButton('add', 'Add result')
      ),
      mainPanel(
        div(id = 'placeholder')
      )
    )
  ),
  server = function(input, output, session) {
    dataset <- reactive({ switch(input$data,
      'rock' = rock, 'pressure' = pressure, 'cars' = cars)
    })
    
    observeEvent(input$add, {
      id <- paste0(input$tool, input$add)
      insertUI('#placeholder', 
        ui = switch(input$tool,
          'summary' = verbatimTextOutput(id),
          'plot' = plotOutput(id),
          'head' = tableOutput(id))
      )
      output[[id]] <-
        if (input$tool == 'summary') renderPrint({ summary(isolate(dataset())) })
        else if (input$tool == 'plot') renderPlot({ plot(isolate(dataset())) })
        else if (input$tool == 'head') renderTable({ head(isolate(dataset())) })
    })
  }
)

ui側での定義

サイドバーにactionButtonを配置します。ボタンの押下されると、reactiveにinput$addに値が返されます。

actionButton('add', 'Add result')

メインパネルには、HTMLでid属性placeholderを指定して

タグを埋め込みます。

div(id = 'placeholder')

server側での定義

ボタン(input$add)に対応するイベントを記述します。以下が、最もシンプルなinput$addに対応したobserveEventの記述例です。

observeEvent(input$add, {
  insertUI(selector = "#placeholder",
           where = "afterEnd",
           ui = tagList(...))
})

insertUIの各引数では、

  • selector#placeholderでUIオブジェクトを挿入したいjQueryのselectorを指定

  • whereはデフォルト値のbeforeEndとなり、追加するUIオブジェクトは、最後に追加された子UIの後に挿入されます

  • uiで挿入したいUIオブジェクトを指定します。

observeEvent(input$add, {
  id <- paste0(input$tool, input$add)
  insertUI('#placeholder', 
    ui = switch(input$tool,
      'summary' = verbatimTextOutput(id),
      'plot' = plotOutput(id),
      'head' = tableOutput(id))
  )
  output[[id]] <-
    if (input$tool == 'summary') renderPrint({ summary(isolate(dataset())) })
    else if (input$tool == 'plot') renderPlot({ plot(isolate(dataset())) })
    else if (input$tool == 'head') renderTable({ head(isolate(dataset())) })
})

まとめ

  • insertUIを用いて、動的にUIコンポーネントを追加することができます。

  • uiでコンポーネントを追加していく場所をdivタグにidを指定して確保し、serverでボタン押下などの追加のユーザ入力イベントが起きたときにinsertUIを実行します。

  • renderUIと比較すると、複数のコンポーネントを配置したい場合に、再度全体をrenderし直す必要がなく、より動的なアプリケーションにできることが特徴です。

Shinyアプリケーション作成のTips in ポケモン検索

Shiny

はじめに

Shinyのチュートリアルで、ちょっと欠けているなと思う部分を補足説明するためにちょうど良さそうな実装例がなかったので、自分で作ってみました。個体値やタイプでポケモンを検索するShinyアプリケーションです。ポケモンでShinyというと誤解を招きそうなんですが、色違いではありません。*1

https://phmpk.shinyapps.io/pokemonsearch/

shinyappsにdeployして、ソースコードをgithubにアップロードしています。

https://github.com/qhmqk/psearch

使ったデータは、Kaggleで各種解析に使うために投稿されたデータセットです。第6世代までの721匹のポケモンが対象*2です。

https://www.kaggle.com/abcsds/pokemon

ポケモンの名前やパラメータ名を一部修正して使用しています。

実行例

左側のサイドバーで、スライダーを使ってポケモンの種族値の範囲を設定し、チェックボックスでタイプを選択すると、右側のメインパネルの表に反映されます。

表中の行を選択すると、選択されたポケモンの個体値がメインパネル下側のレーダーチャートと散布図に表示されます。レーダーチャートは6つの個体値HABCDSを表示します。散布図は縦軸に6つの個体値合計を、横軸に最重要なパラメータである素早さをプロットします。散布図中にプロットされる点は、上の表に表示されているポケモン一覧で、選択されたポケモンにはラベルが付きます。

f:id:phmpk:20170303204252p:plain

Shinyアプリケーション作成のTips

Rangeフォーマットで、sliderInputの値を取得

05_slidersでは、sliderInputのそれぞれのフォーマットの実行例があるんですが、server側で値をinput$inputIdで取得しています。

sliderInput("range", "Range:", min = 1, max = 1000, value = c(200,500))

上記のsliderInputで入力される値は2つあり、input$rangeはカンマ区切りで2つの値を並べて返します。このとき、2つの値をそれぞれ個別に取得するときにはinput$range[1], input$range[2]と記述します。

ポケモン検索では、番号やステータスの値に対応するsliderInputの値を、範囲指定で式とすることにより、ポケモンのデータ全体から部分集合を生成しています。

subset(pokemon, 
    Number >= input$number[1] & 
    Number <= input$number[2] &
    Total >= input$total[1] &
    Total <= input$total[2] &
    ...
)

DTによるdata.frameの表示

DTdata.frameをインタラクティブな表として出力するためのライブラリです。チュートリアルには含まれていませんが、ソートや表示数の設定などが可能で、データ内容を確認するのに便利です。

f:id:phmpk:20170303204311p:plain

使用方法は、DT::renderDataTableの引数としてデータを指定して、ui側でDT::dataTableOutputとして表示するだけで、通常の表を出力するときとほとんど一緒です。

ui
DT::dataTableOutput('dt1')
server
pokemon <- read.csv("Pokemon_r.csv")
output$dt1 <- DT::renderDataTable(pokemon)

更新したuiを入力として使用

例えばUI上にコンポーネントA, B, Cがあるとき、Aでユーザが入力した値に応じてBの要素が更新され、そのBをCの要素を更新するための入力として使用する、といった実装にしたい場合があります。

  • A:サイドバーのスライダーとチェックボックス

  • B:メインパネルのDT表

  • C:メインパネルのレーダーチャート

  • D:メインパネルの散布図

4つのコンポーネントの依存関係は以下の通りです。

入力 出力
A B
B C
A,B D

Aの入力に依存してBの表示が変わるため、Cは間接的にAと依存関係があります。AとBの入力をDで重ねてプロットしています。

output$radarchart, output$scatterPlotの2つは、DTの表で選択された行を指すinput$dt1_rows_selectedの値を参照しています。

ShinyでrenderPlotとggplot2を使って重ね描き

renderPlotの引数を指定するときには、プロットするオブジェクトではなく式(reactive expression)を指定します。通常、ggplot2を使うときには、

p <- ggplot(mtcars, aes(wt, mpg))
p + geom_point()

# Add aesthetic mappings
p + geom_point(aes(colour = factor(cyl)))

# Change scales
p + geom_point(aes(colour = cyl)) + scale_colour_gradient(low = "blue")

のようにオブジェクトpを更新することが多いです。Shinyで同じように記述する場合には、reactive({})で各種データを更新してまとめてプロットという書き方になります。renderPlot({})で、そのままオブジェクトpの内容を更新するように記述すると式として評価されないので、プロットすることができません。

オブジェクトに代入すること無く、式としてgeom_pointgeom_labelを上書きしていくときには、下記のようにggplot()+...と記述します。

f:id:phmpk:20170303204330p:plain

output$scatterPlot <- renderPlot({
    ps <- pokemonSubset()
    ggplot() + 
      geom_point(data = ps, aes(x = Speed, y = Total, color = Type1)) +
      geom_point(data = ps[max(1,input$dt1_rows_selected),], aes(x = Speed, y = Total), color = 'black', size = 3) + 
      geom_label_repel(data = ps[max(1,input$dt1_rows_selected),], aes(x = Speed, y = Total), label = ps[max(1,input$dt1_rows_selected),"Name"])
})

サイドバーのスライダーとチェックボックスで選択されたポケモンと、表で選択されたポケモンを重ねてプロットしています。

shinyapps.ioに(制限付き)無料でアプリケーションをdeploy

hinyapps.ioはRStudioが運営しているwebサービスでRStudio IDEから簡単な操作でShinyアプリケーションをdeployできます。制限はありますが、無料で使用することができます。

将来的にはGUI操作だけでdeployできるようにする予定みたいですが、現時点では対応していません。私がshinyappsにdeployするまでの手順は以下の通りでした(2017年3月時点)。

  1. hinyapps.ioにsign up

  2. rsconnectをインストール(install.packages('rsconnect'))

  3. rsconnectでshinyappsに接続します。ブラウザからshinyappsを操作すると、クリップボードにname, token, secretを含んだrsconnect::setAccountInfo(name="<ACCOUNT>", token="<TOKEN>", secret="<SECRET>")というコマンドがコピーされるので、コンソールから入力します。

  4. deployApp("path")runAppでローカル実行するときと全く同じように、shinyapps.ioにアプリケーションをdeploy

RStudioからpublish applicationでdeployすることもできます。

ソースコード

uiでは、sidebarLayoutを使用して、サイドバーにスライダー、チェックボックスを配置、メインパネルに表(DT)、レーダーチャート(fbsb)、散布図(ggplot2)を配置しています。

ui.R

library(shiny)
fluidPage(
  titlePanel("Pokemon search"),
  sidebarLayout(
    sidebarPanel(
      tags$div(class="header", checked=NA,
               tags$a(href="http://r-tips.hatenablog.com", "Blog"),
               tags$p("If you want to know this application in detail, check out my blog"),
               tags$a(href="https://www.kaggle.com/abcsds/pokemon", "Kaggle datasets"),
               tags$p("Data is from Kaggle datasets"),
               tags$a(href="https://github.com/qhmqk/psearch", "Github repo"),
               tags$p("Source repository is on Github")
      ),
      # sliders to select status of 6 parameters
      sliderInput("number", "Number:",
                  min = 1, max = 721, value = c(1,721)),
      sliderInput("total", "Total:",
                  min = 180, max = 780, value = c(180,780)),
      sliderInput("hp", "HP:",
                  min = 1, max = 255, value = c(5,255)),
      sliderInput("attack", "Attack:",
                  min = 5, max = 190, value = c(5,190)),
      sliderInput("defense", "Defense:",
                  min = 5, max = 230, value = c(5,230)),
      sliderInput("spatk", "Special Atk:",
                  min = 10, max = 194, value = c(10,194)),
      sliderInput("spdef", "Spcial Def:",
                  min = 20, max = 230, value = c(20,230)),
      sliderInput("speed", "Speed:",
                  min = 5, max = 180, value = c(5,180)),
      # checkboxes to select type
      tags$p("Type 1"),
      checkboxInput("normal1", "Normal", TRUE),
      checkboxInput("grass1", "Grass", TRUE),
      checkboxInput("fire1", "Fire", TRUE),
      checkboxInput("water1", "Water", TRUE),
      checkboxInput("bug1", "Bug", TRUE),
      checkboxInput("flying1", "Flying", TRUE),
      checkboxInput("electric1", "Electric", TRUE),
      checkboxInput("ice1", "Ice", TRUE),
      checkboxInput("rock1", "Rock", TRUE),
      checkboxInput("ground1", "Ground", TRUE),
      checkboxInput("poison1", "Poison", TRUE),
      checkboxInput("fighting1", "Fighting", TRUE),
      checkboxInput("psychic1", "Psychic", TRUE),
      checkboxInput("ghost1", "Ghost", TRUE),
      checkboxInput("dark1", "Dark", TRUE),
      checkboxInput("dragon1", "Dragon", TRUE),
      checkboxInput("steel1", "Steel", TRUE),
      checkboxInput("fairy1", "Fairy", TRUE)
    ),
    mainPanel(
      DT::dataTableOutput('dt1'),
      plotOutput('radarPlot'),
      plotOutput('scatterPlot')
    )
  ) 
)

server.R

ポケモンの名前やステータスが記述されたcsvを読み込み、reactive expressionでサイドバーでの入力に対応したポケモン一覧の部分集合を生成しています。

生成した部分集合を表として出力、表の中で選択されたポケモンをレーダーチャートに表示するとともに、散布図で選択されたポケモンにラベルを付けています。

library(shiny)
library(DT)
library(fmsb)
library(ggplot2)
library(ggrepel)

shinyServer(function(input, output, session) {
  pokemon <- read.csv("Pokemon_r.csv")
  pokemonSubset <- reactive({
    subset(pokemon, 
           Number >= input$number[1] & 
           Number <= input$number[2] &
           Total >= input$total[1] &
           Total <= input$total[2] &
           HP >= input$hp[1] &
           HP <= input$hp[2]&
           Attack >= input$attack[1] &
           Attack <= input$attack[2] &
           Defense >= input$defense[1] &
           Defense <= input$defense[2] &
           SpecialAtk >= input$spatk[1] &
           SpecialAtk <= input$spatk[2] &
           SpecialDef >= input$spdef[1] &
           SpecialDef <= input$spdef[2] & 
           Speed >= input$speed[1] &
           Speed <= input$speed[2] &
           (
            (input$normal1 & (Type1 == "Normal")) |
            (input$grass1 & (Type1 == "Grass")) |
            (input$fire1 & (Type1 == "Fire")) |
            (input$water1 & (Type1 == "Water")) |
            (input$bug1 & (Type1 == "Bug")) |
            (input$flying1 & (Type1 == "Flying")) |
            (input$electric1 & (Type1 == "Electric")) |
            (input$ice1 & (Type1 == "Ice")) |
            (input$rock1 & (Type1 == "Rock")) |
            (input$ground1 & (Type1 == "Ground")) |
            (input$poison1 & (Type1 == "Poison")) |
            (input$fighting1 & (Type1 == "Fighting")) |
            (input$psychic1 & (Type1 == "Psychic")) |
            (input$ghost1 & (Type1 == "Ghost")) |
            (input$dark1 & (Type1 == "Dark")) |
            (input$dragon1 & (Type1 == "Dragon")) |
            (input$steel1 & (Type1 == "Steel")) |
            (input$fairy1 & (Type1 == "Fairy"))
           ))
  })
  output$dt1 <- DT::renderDataTable(pokemonSubset(), selection = list(mode = 'single', selected = 1))
  output$radarPlot <- renderPlot({
    ps <- pokemonSubset()
    maxmin <- data.frame(
      hp = c(120, 1),
      attack = c(120, 1),
      defense = c(120, 1),
      spattack = c(120, 1),
      spdefense = c(120, 1),
      speed = c(120, 1))
    dat <- data.frame(
      hp = ps[1,"HP"],
      attack = ps[max(1,input$dt1_rows_selected),"Attack"],
      defense = ps[max(1,input$dt1_rows_selected),"Defense"],
      spattack = ps[max(1,input$dt1_rows_selected),"SpecialAtk"],
      spdefense = ps[max(1,input$dt1_rows_selected),"SpecialDef"],
      speed = ps[max(1,input$dt1_rows_selected),"Speed"])  
    dat <- rbind(maxmin, dat)   
    radarchart(dat, axistype = 2, 
               seg = 5, plty = 1, 
               pfcol = "#FF00004C",
               vlcex = 1.5,centerzero = TRUE, 
               title = ps[max(1,input$dt1_rows_selected),"Name"])
  })
  output$scatterPlot <- renderPlot({
    ps <- pokemonSubset()
    ggplot() + 
      geom_point(data = ps, aes(x = Speed, y = Total, color = Type1)) +
      geom_point(data = ps[max(1,input$dt1_rows_selected),], aes(x = Speed, y = Total), color = 'black', size = 3) + 
      geom_label_repel(data = ps[max(1,input$dt1_rows_selected),], aes(x = Speed, y = Total), label = ps[max(1,input$dt1_rows_selected),"Name"])
  })
})

*1:色違いのポケモンを、Shinyと言います。例えば、色違いのリザードンは、Shiny Charizardと呼びます。

*2:Kaggleには、第7世代サン・ムーンのデータセットも投稿されていたんですが、未解禁のポケモンや技、特性まで含まれていて、いろいろまずそうだったので使用していません。未解禁のポケモンデータは現時点では、ソフトを不正な方法で解析しない限り出てこないデータです。

renderUIを用いた動的なShinyのユーザインタフェース

Shiny

このエントリでは、rstudio::conf 2017で紹介されたShinyのinsertUIを解説します。

https://github.com/bborgesr/rstudio-conf2017

githubで公開されたソースコードを引用しています。

Shinyアプリケーションでは、予めui.R、または (app.R中の) uiオブジェクトとして、固定のUIを配置する必要があります。

動的なUIでは、入力に応じて表示されるUIコンポーネントの種類が変わります。Shinyで動的なUIを実現するための方法の一つがrenderUIです。

renderUIの使用例

「01-renderUI.R」はrenderUIの使用例です。ユーザの入力により、renderUIで動的なUIを表示します。

実行例

runAppでアプリケーションを実行すると、初期状態で、選択されたdatasetのsummaryが表示されています。

f:id:phmpk:20170227191436p:plain

plot, headを選択すると、summaryが表示されていたUIコンポーネントのあったメインパネルに、plotとheadが表示されます。

f:id:phmpk:20170227191456p:plain

f:id:phmpk:20170227191511p:plain

ソースコード

renderUIの使用例のコードを以下に示します。

library(shiny)
library(datasets)

shinyApp(
  ui = fluidPage(
    titlePanel('Using renderUI'),
    sidebarLayout(
      sidebarPanel(
        selectInput('data', 'Choose a dataset', c('rock', 'pressure', 'cars')),
        radioButtons('tool', 'Choose a tool', c('summary', 'plot', 'head'))
      ),
      mainPanel(
        uiOutput('result')
      )
    )
  ),
  server = function(input, output, session) {
    dataset <- reactive({ switch(input$data,
      'rock' = rock, 'pressure' = pressure, 'cars' = cars)
    })
    
    output$result <- renderUI({
      switch(input$tool,
        'summary' = verbatimTextOutput('summary'),
        'plot' = plotOutput('plot'),
        'head' = tableOutput('head'))
    })
    
    output$summary <- renderPrint({ summary(dataset()) })
    output$plot <- renderPlot({ plot(dataset()) })
    output$head <- renderTable({ head(dataset()) })
  }
)

ui側での定義

ui側でrenderUIを用いるためには、uiOutput(id)でコンポーネントを定義します。

使用例では、メインパネル中に宣言があります。

uiOutput('result')

server側でresultで定義されたuiコンポーネントを表示します。

server側での定義

server側では、renderUIで、以下のいずれかの方法で出力を返します。

  • output[[id]] <- renderUI({ ... }

  • output[[id]] <- renderUI({ tagList(...) })

使用例では、switch文を用いて、

output$result <- renderUI({
  switch(input$tool,
    'summary' = verbatimTextOutput('summary'),
    'plot' = plotOutput('plot'),
    'head' = tableOutput('head'))
})

ユーザの入力に対応して、verbatimTextOutput, plotOutput, tableOutputのいずれかを出力に指定します。

出力として定義したsummary, plot, headはそれぞれ対応するrender関数によるオブジェクトの定義が必要です。

output$summary <- renderPrint({ summary(dataset()) })
output$plot <- renderPlot({ plot(dataset()) })
output$head <- renderTable({ head(dataset()) })

まとめ

  • renderUIを用いて、ui中にuiOutputで指定したコンポーネントを動的に表示することができます。

  • ui側でuiOutputによるコンポーネントの定義、server側でrenderUIを用いて入力に応じて動的に表示するコンポーネントを変えます。

  • 表示するコンポーネントを変えるだけでなく、新たにコンポーネントを追加表示する場合には、uiOutputで確保したスロットに再度renderによる表示が必要となります。これを回避して、より動的にコンポーネントの追加表示を行うのに使用するのがinsertUIです。

ShinyアプリケーションをHTMLでカスタマイズする方法

Shiny

このエントリは、Shiny公式サイトのCustomize your UI with HTMLを抜粋・翻訳・追記したものです。

https://shiny.rstudio.com/articles/html-tags.html

Shinyアプリケーションに任意のHTMLを追加してカスタマイズする方法を説明します。

Shinyアプリケーションのユーザインタフェース(UI)はweb上のドキュメントであり、ui.RがHTMLを生成するRの関数を実行して、webアプリケーションに変換しています。

shinyUIが生成するHTMLの説明

例として、01_helloを取り上げます。以下の説明は、08_htmlと重複する部分があります。

library(shiny)
runExample("01_hello")

上記のコードでサンプルアプリケーション「01_hello」が実行されます。01_helloのui.Rスクリプトを以下に示します。

library(shiny)

# Define UI for application that draws a histogram
shinyUI(fluidPage(

  # Application title
  titlePanel("Hello Shiny!"),

  # Sidebar with a slider input for the number of bins
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
    ),

    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  )
))

このコードは以下の図のようなアプリケーションを生成します。

f:id:phmpk:20161230151451p:plain

ui.Rスクリプト中shinyUI関数を呼び出します。shinyUI関数がHTMLを返すR関数を呼び出しています。コード内にHTMLを書く必要はなく、HTMLについて注意する必要はありません。以下のコードが返しているHTMLを、コメントアウトした行に記述します。

fluidPage(

  # Application title
  titlePanel("Hello Shiny!"),

  # Sidebar with a slider input for the number of bins
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
    ),

    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

## <div class="container-fluid">
##   <h2 style="padding: 10px 0px;">Hello Shiny!</h2>
##   <div class="row-fluid">
##     <div class="span4">
##       <form class="well">
##         <div>
##           <label class="control-label" for="bins">Number of bins:</label>
##           <input id="bins" type="slider" name="bins" value="30" class="jslider" data-## from="1" data-to="50" data-step="1" data-skin="plastic" data-round="FALSE## " data-locale="us" data-format="#,##0.#####" data-smooth="FALSE"/>
##         </div>
##       </form>
##     </div>
##     <div class="span8">
##       <div id="distPlot" class="shiny-plot-output" style="width: 100% ; height: ## 400px"></div>
##     </div>
##   </div>
## </div> 
titlePanel("Hello Shiny!")
## <h2 style="padding: 10px 0px;">Hello Shiny!</h2>

上記のHTMLに、任意のHTMLを追加してカスタマイズするために、tagsオブジェクトを使用します。

tags

shiny::tagsは110個の関数のリストです。各関数でHTMLタグを追加してアプリケーションをビルドします。関数名と、追加するHTMLタグの名前は対応しています。それぞれのタグの詳細はShiny HTML tags glossaryに書かれています。

names(tags)
##   [1] "a"           "abbr"        "address"     "area"        "article"
##   [6] "aside"       "audio"       "b"           "base"        "bdi"
##  [11] "bdo"         "blockquote"  "body"        "br"          "button"
##  [16] "canvas"      "caption"     "cite"        "code"        "col"
##  [21] "colgroup"    "command"     "data"        "datalist"    "dd"
##  [26] "del"         "details"     "dfn"         "div"         "dl"
##  [31] "dt"          "em"          "embed"       "eventsource" "fieldset"
##  [36] "figcaption"  "figure"      "footer"      "form"        "h1"
##  [41] "h2"          "h3"          "h4"          "h5"          "h6"
##  [46] "head"        "header"      "hgroup"      "hr"          "html"
##  [51] "i"           "iframe"      "img"         "input"       "ins"
##  [56] "kbd"         "keygen"      "label"       "legend"      "li"
##  [61] "link"        "mark"        "map"         "menu"        "meta"
##  [66] "meter"       "nav"         "noscript"    "object"      "ol"
##  [71] "optgroup"    "option"      "output"      "p"           "param"
##  [76] "pre"         "progress"    "q"           "ruby"        "rp"
##  [81] "rt"          "s"           "samp"        "script"      "section"
##  [86] "select"      "small"       "source"      "span"        "strong"
##  [91] "style"       "sub"         "summary"     "sup"         "table"
##  [96] "tbody"       "td"          "textarea"    "tfoot"       "th"
## [101] "thead"       "time"        "title"       "tr"          "track"
## [106] "u"           "ul"          "var"         "video"       "wbr"

divタグを生成するためには、以下のコードを実行します。

tags$div()
## <div></div> 

主なタグには、tags$なしのヘルプ関数が用意されています。例えばHTMLタグのcodetags$codeを呼び出します。tags$を付けることなくヘルパー関数を呼び出せるタグ関数は、a, br, code, div, em, h1, h2, h3, h4, h5, h6, hr, img, p, pre, span, strongです。

他のタグの名前を冠した関数はRのネイティブな関数と重複しているので、tags$を付けて呼び出す必要があります。

属性(Attributes)

タグ関数の引数は、そのままHTMLの属性を与えられます。引数の名前が属性の名前、引数の値が属性の値です。例えば、divタグに属性を追加するときは、以下のように、

tags$div(class = "header")
## <div class="header"></div>

値無しで属性を追加するときには、NAを設定します:

tags$div(class = "header", checked = NA)
## <div class="header" checked></div>

タグ関数の引数にネストしたHTMLを追加

各タグ関数の中に、ネストしたHTMLを引数にして加えることができます。

tags$div(class = "header", checked = NA,
  tags$p("Ready to take the Shiny tutorial? If so"),
  tags$a(href = "shiny.rstudio.com/tutorial", "Click Here!")
)
## <div class="header" checked>
##   <p>Ready to take the Shiny tutorial? If so</p>
##   <a href="shiny.rstudio.com/tutorial">Click Here!</a>
## </div> 
withTagsによるtags$の省略

withTags関数内ではtags$なしで、タグ関数を記述できます。

withTags({
  div(class="header", checked=NA,
    p("Ready to take the Shiny tutorial? If so"),
    a(href="shiny.rstudio.com/tutorial", "Click Here!")
  )
})
## <div class="header" checked>
##   <p>Ready to take the Shiny tutorial? If so</p>
##   <a href="shiny.rstudio.com/tutorial">Click Here!</a>
## </div>

01_helloのui.Rファイルに上記で説明したタグを追加すると、以下のコードになります。

library(shiny)

# Define UI for application that draws a histogram
shinyUI(fluidPage(

  # Application title
  titlePanel("Hello Shiny!"),

  # Sidebar with a slider input for the number of bins
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),

      # adding the new div tag to the sidebar            
      tags$div(class="header", checked=NA,
               tags$p("Ready to take the Shiny tutorial? If so"),
               tags$a(href="shiny.rstudio.com/tutorial", "Click Here!")
      )
    ),

    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  )
))

新しいHTMLとして、文とリンクが01_helloに追加されています。

f:id:phmpk:20170210195002p:plain

属性と子HTMLタグへの条件式

タグ関数の引数にNULLを設定すると、その引数はHTML出力中に現れません。以下のようにif文で条件式を指定することもできます。

tags$div(class = "header", id = NULL,
    NULL,
    "line 2"
)
## <div class="header">line 2</div> 


tags$div(class = "header", id = if (FALSE) 100,
    if (FALSE) "line 1",
    "line 2"
)
## <div class="header">line 2</div> 

List関数によるネスト

Rのlist関数を用いて、タグに子のリストを渡せます。タグ関数内で呼び出したlistは、そのタグの子としてリスト内の各要素が追加されます。

tags$div(class="header", checked=NA,
  list(
    tags$p("Ready to take the Shiny tutorial? If so"),
    tags$a(href="shiny.rstudio.com/tutorial", "Click Here!"),
    "Thank you"
  )
)
## <div class="header" checked>
##   <p>Ready to take the Shiny tutorial? If so</p>
##   <a href="shiny.rstudio.com/tutorial">Click Here!</a>
##   Thank you
## </div> 

HTMLの直接出力

タグオブジェクト、またはShinyUIの中に直接HTMLを記述することはできません。ShinyはHTMLそのままであれば、文字列として扱います。

tags$div(
  "<strong>Raw HTML!</strong>"
)
## <div>&lt;strong&gt;Raw HTML!&lt;/strong&gt;</div>

HTMLをそのまま加えるためには、HTML関数を用います。HTMLは(HTMLの)文字列を引数に取って、(Shinyの特別なクラスの)HTMLとして返します。

tags$div(
  HTML("<strong>Raw HTML!</strong>")
)
## <div><strong>Raw HTML!</strong></div> 

HTMLに渡されたコードに不備があってもエラーを返さない、という点に注意する必要があります。