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

ふんわり R-tips

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

Shinyアプリケーションでブラウザ上に通知を表示

Shiny

このエントリは、Shiny公式サイトのNotificationの説明を抜粋・翻訳・追記したものです。

Shiny - Notifications

バージョン0.14から、showNotification()関数を用いてShinyでブラウザ上に通知を表示できるようになっています。ShinyのGALLERYに例があります。

この例では、Showボタンが押されるときに注釈を表示するためにobserveEbent()を用いています。

shinyApp(
  ui = fluidPage(
    actionButton("show", "Show")
  ),
  server = function(input, output) {
    observeEvent(input$show, {
      showNotification("This is a notification.")
    })
  }
)

通知はブラウザ端の右下に表示されて、5秒たつと自動的に消えます。

f:id:phmpk:20170113101650p:plain

通知の表示方法を制御するためのオプションもあります。

デフォルトの色はグレーですが、type引数で他の色を指定できます。以下はtype引数を「defalut」「message」「warning」「error」にした場合です。

f:id:phmpk:20170113101831p:plain

通知の右側にデフォルトで閉じるボタンが表示されていますが、closeButton = FALSEで取り除けます。

action引数は、注釈の中のコンテンツを提供する追加の方法です。actionUIコンポーネントがメインテキストのすぐ下に現れます。別れていますが、CSSでカスタマイズできます。

showNotification()関数は、サーバ側から通知を消すためにremoveNotification()に渡すID値を返します。以下の例では、通知を表示するためのボタンと、もう一方の通知を消すためのボタンがあります。

shinyApp(
  ui = fluidPage(
    actionButton("show", "Show"),
    actionButton("remove", "Remove")
  ),
  server = function(input, output) {
    # 注釈ID
    id <- NULL

    observeEvent(input$show, {
      # 注釈が表示されているときに、もう片方を追加しないようにする
      if (!is.null(id))
        return()
      # あとで取り除くためにIDを保存
      id <<- showNotification(paste("Notification message"), duration = 0)
    })

    observeEvent(input$remove, {
      if (!is.null(id))
        removeNotification(id)
      id <<- NULL
    })
  }
)

Shinyにおけるコンポーネントのレイアウト方法

Shiny

概要

Shinyにおけるコンポーネントのレイアウト方法を説明します。シンプルなサイドバーレイアウトから、階層付きのナビゲーションページまでHTML/CSSフレームワークのBootstrap 2で利用できるコンポーネントの配置がサポートされています。

  1. サイドバーとメインからなるシンプルなデフォルトのサイドバーレイアウト

  2. Shiny grid layout systemを用いたグリッドレイアウト

  3. タブセットtabsetPanel()ナビゲーションリストnavlistPanel()を用いたセグメント分けレイアウト

  4. ナビゲーションページnavbarPare()を用いた階層付きコンポーネント配置

サイドバーレイアウト

デフォルトのサイドバーレイアウトは、入力用のサイドバーと出力のための広いメイン領域で構成されています。サンプルアプリケーションの01_helloは、サイドバーにスライダー、メインにプロットを出力する例です。

f:id:phmpk:20161230151451p:plain

library(shiny)

fluidPage(
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

Code license:MIT

サイドバーレイアウトでは、サイドバーの位置がデフォルトでメインの左側ですが、以下のように、positionを指定することで位置を変えることもできます。

sidebarLayout(position = "right",
              
  sidebarPanel(
    # 入力用コントロール
  ),
  mainPanel(
    # 出力 
  )
)

グリッドレイアウト

サイドバーレイアウトも、グリッドレイアウトの一つです。fluidRow()で行を作成し、各行にcolumn()で列を作成します。列の幅は12分割で、fluidRow()関数で12以下の値を指定します。

fluidRow(), column(), wellPanel()を用いてサイドバーレイアウトを記述すると、以下のようなコードになります。

shinyUI(fluidPage(

  titlePanel("Hello Shiny!"),

  fluidRow(
  
    column(4,
      wellPanel(
        sliderInput("obs", "Number of observations:",  
                    min = 1, max = 1000, value = 500)
      )       
    ),

    column(8,
      plotOutput("distPlot")
    )
  )
))

column()の最初のパラメータは幅の大きさで、すべての幅の合計が12になるようにします。

以下の例では、上部にプロットを、下部に3つの列からなるプロット操作用の入力コントロールを配置しています。

f:id:phmpk:20170105203435p:plain

library(shiny)
library(ggplot2)

function(input, output) {
  
  dataset <- reactive({
    diamonds[sample(nrow(diamonds), input$sampleSize),]
  })
  
  output$plot <- renderPlot({
    
    p <- ggplot(dataset(), aes_string(x=input$x, y=input$y)) + geom_point()
    
    if (input$color != 'None')
      p <- p + aes_string(color=input$color)
    
    facets <- paste(input$facet_row, '~', input$facet_col)
    if (facets != '. ~ .')
      p <- p + facet_grid(facets)
    
    if (input$jitter)
      p <- p + geom_jitter()
    if (input$smooth)
      p <- p + geom_smooth()
    
    print(p)
    
  })
  
}
library(shiny)
library(ggplot2)

dataset <- diamonds

shinyUI(fluidPage(

  title = "Diamonds Explorer",
  
  plotOutput('plot'),
  
  hr(),

  fluidRow(
    column(3,
      h4("Diamonds Explorer"),
      sliderInput('sampleSize', 'Sample Size', 
                  min=1, max=nrow(dataset), value=min(1000, nrow(dataset)), 
                  step=500, round=0),
      br(),
      checkboxInput('jitter', 'Jitter'),
      checkboxInput('smooth', 'Smooth')
    ),
    column(4, offset = 1,
      selectInput('x', 'X', names(dataset)),
      selectInput('y', 'Y', names(dataset), names(dataset)[[2]]),
      selectInput('color', 'Color', c('None', names(dataset)))
    ),
    column(4,
      selectInput('facet_row', 'Facet Row', c(None='.', names(dataset))),
      selectInput('facet_col', 'Facet Column', c(None='.', names(dataset)))
    )
  )
))
  • 下部の入力コントロールを、3つの列に分割。

  • 2つ目のcolumun()にあるoffset = 1は、1つ目と2つ目の列の間にスペースを挿入するために指定。

  • titlePanel()ではなく、fluidPage()の引数titleに値を入力。

タブセット

タブセットは、tabsetPanel()により、タブでアプリケーションを分割するときに使用します。サンプルアプリケーションの06_tabsetsはタブセットの使用例です。

f:id:phmpk:20161230155218p:plain

shinyUI(fluidPage(
    
  titlePanel("Tabsets"),
  
  sidebarLayout(
    sidebarPanel(
      # 06_tabsetsの入力コントロール。
      # レイアウト説明には関係しないため省略
    ),
    
    mainPanel(
      tabsetPanel(type = "tabs", 
        tabPanel("Plot", plotOutput("plot")), 
        tabPanel("Summary", verbatimTextOutput("summary")), 
        tabPanel("Table", tableOutput("table"))
      )
    )
  )
))

タブはデフォルトで上部に配置されます。positionを指定することで、左右や下部にも配置することができます。以下に、下側に配置する場合の例を示します。tabsetPanel()でpositionを下側に指定しています。

tabsetPanel(position = "below",
  tabPanel("Plot", plotOutput("plot")), 
  tabPanel("Summary", verbatimTextOutput("summary")), 
  tabPanel("Table", tableOutput("table"))
)

ナビゲーションリスト(Navlists)

tabsetPanel()の代わりにnavlistPanel()を用いることで、タブではなくナビゲーションリストでコンポーネントを配置することができます。以下は、navlistPanel()の使用例です。

f:id:phmpk:20170105205522p:plain

図に対応するコードを示します。タブで指定するコンポーネントは、例なので空です。

shinyUI(fluidPage(
  
  titlePanel("Application Title"),
  
  navlistPanel(
    "Header A",
    tabPanel("Component 1"),
    tabPanel("Component 2"),
    "Header B",
    tabPanel("Component 3"),
    tabPanel("Component 4"),
    "-----",
    tabPanel("Component 5")
  )
))

ナビゲーションバーページ(NavBar Page)

上部に配置したナビゲーションバーによって、大きくShinyアプリケーションを分割して動作させることが可能です。以下の図はnavbarPage()によってナビゲーションバーを配置した例です。

f:id:phmpk:20170105205311p:plain

shinyUI(navbarPage("My Application",
  tabPanel("Component 1"),
  tabPanel("Component 2"),
  tabPanel("Component 3")
))

例なのでtabPanel()は空です。

セカンダリーナビゲーション

navbarMenu()を用いて、2段目までの深さのナビゲーションを配置することができます。1段目のナビゲーションバーに、タブパネルを追加します。

f:id:phmpk:20170105205705p:plain

shinyUI(navbarPage("My Application",
  tabPanel("Component 1"),
  tabPanel("Component 2"),
  navbarMenu("More",
    tabPanel("Sub-Component A"),
    tabPanel("Sub-Component B"))
))

ナビゲーションバーの追加オプション

navbarPage()に引数を指定して、オプションを追加することができます。

引数 説明
header すべてのタブパネルの上側の共通のヘッダとして表示するためのタグのリスト用タグ
footer すべてのタブパネルの下側の共通のヘッダとして表示するためのタグのリスト用タグ
inverse TRUEで、ナビゲーションバーのバックグラウンドを暗く、テキストを明るくする
collapsable TRUEで、ブラウザが940pixel以下になったときに、自動的にナビゲーションの項目をメニューとして掴む(スマホのような小さなタッチスクリーンで見るときに有用)

Shinyアプリケーションを単一ファイルapp.Rから実行する方法

Shiny

Shinyアプリケーションを一つのファイルから実行する方法を説明します。

Shinyのバージョン0.10.2から、server.Rとui.Rの2つのファイルからビルドすることなく、app.RファイルひとつだけでShinyアプリケーションが実行可能になっています。

新たにディレクトリを作成し、そのディレクトリ下にapp.Rファイルを作成します。runApp("ディレクトリ名")を実行すると、app.Rに記述されたShinyアプリケーションが実行されます。サンプルアプリケーション01_helloを編集して、server.Rとui.Rからapp.Rを作成して、実行する例を示します。

01_helloは入力用のスライドバーと出力用のヒストグラムが配置されたShinyのサンプルアプリケーションです。

r-tips.hatenablog.com

server.R

library(shiny)

function(input, output) {
  output$distPlot <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}

Code license:MIT

ui.R

library(shiny)

fluidPage(
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

Code license:MIT

server.Rとui.Rから作成したapp.R

app.Rでは以下の例に示すように、UIオブジェクトとserver関数を引数としてshinyApp()を呼び出します。

library(shiny)

# server関数functionの返す値を変数へ
server <- function(input, output) {
  output$distPlot <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}

# uiオブジェクトfluidPage()を変数へ
ui <- fluidPage(
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

# uiオブジェクトとserver関数を引数として、shiniApp()実行
shinyApp(ui = ui, server = server)

Code license:MIT

runApp()とapp.Rなしで、Shinyアプリケーションを実行

shinyApp()関数は、shiny.appobjクラスのオブジェクトを返します。このオブジェクトがコンソールに返されたときに、print.shiny.appobj()関数によりアプリケーションが出力されます。print.shiny.appobj()が、オブジェクトからShinyアプリケーションを実行する関数です。

同様の方法で、app.Rという名前のファイルでなく、そのファイルをディレクトリ下に置いていなくても、アプリケーションを実行できます。例えば、test.Rというファイルを作成して、そのファイル内でshinyApp()関数呼び出しを最後に記述し、以下のコードをコンソール上から実行すれば、Shinyアプリケーションが実行されます。

print(source("test.R"))

source()関数が実行されると、shiny.appobj-butが返されます。source()だけでは、まだ出力はされません。print()関数でラップすることにより、Shinyアプリケーションが実行されます。

この方法はお手軽ですが、ディレクトリ下にapp.Rをおいて実行する方法に比べると、いくつかのアドバンテージがなくなります。runApp()関数を実行するとき、Shinyはファイルをモニターしており、ブラウザをリロードするとファイルをリロードします。開発時に、shinyアプリケーションを実行したまま、ファイルを編集するときには、こちらの方が便利です。

Shinyサンプルアプリケーション「11_timer」の説明

Shiny

11_timerは、コントロールなしで時刻のみをテキスト表示する例です。

「11_timer」の実行

library(shiny)
runExample("11_timer")

f:id:phmpk:20161230161902p:plain

server.R

function(input, output, session) {
  output$currentTime <- renderText({
    invalidateLater(1000, session)
    paste("The current time is", Sys.time())
  })
}

Code license:MIT

  • invalidateLater()は、reactiveな動作を無効にするための関数。1000を指定すると、このsessionの実行内では、1秒間reactiveな動作が無効化される。そのため、output$currentTimeに出力される現在時刻の文字列は、1秒毎に更新される

ui.R

fluidPage(
  textOutput("currentTime")
)

Code license:MIT

  • サーバー側でcurrentTimeに入力された時刻の文字列を、textOutput()で表示する

Shinyサンプルアプリケーション「10_download」の説明

Shiny

10_downloadは、データセットを選択と、そのデータをダウンロードするDownloadボタンの使用例です。mainPanelには、選択したCSVファイルの中身を表示します。

「10_download」の実行

library(shiny)
runExample("10_download")

f:id:phmpk:20161230161042p:plain

server.R

function(input, output) {
  datasetInput <- reactive({
    switch(input$dataset,
           "rock" = rock,
           "pressure" = pressure,
           "cars" = cars)
  })
  
  output$table <- renderTable({
    datasetInput()
  })
  
  output$downloadData <- downloadHandler(
    filename = function() { 
         paste(input$dataset, '.csv', sep='') 
     },
    content = function(file) {
      write.csv(datasetInput(), file)
    }
  )
}

Code license:MIT

  • datasetInputに、reactiveにinput$datasetで入力された'rock', 'pressure', 'cars'を指定

  • output$tableに、datasetInput()で指定したデータを表として出力

  • dounloadHandler()でファイル名と、ファイルに格納するデータを指定し、output$downloadDataへ渡して出力

ui.R

fluidPage(
  titlePanel('Downloading Data'),
  sidebarLayout(
    sidebarPanel(
      selectInput("dataset", "Choose a dataset:", 
                  choices = c("rock", "pressure", "cars")),
      downloadButton('downloadData', 'Download')
    ),
    mainPanel(
      tableOutput('table')
    )
  )
)

Code license:MIT

  • サイドバーに、'rock', 'pressure', 'cars'いずれかのデータの種類を選択するリストと、downloadButtonを配置

  • mainPaneloutput&tableで指定した表を出力

Shinyサンプルアプリケーション「09_upload」の説明

Shiny

09_uploadは、ファイルをアップロードして表示する例です。CSVファイルをアップロードして、ヘッダやセパレータを指定すると、表として出力します。

「09_upload」の実行

library(shiny)
runExample("09_upload")

f:id:phmpk:20161230160638p:plain

server.R

library(shiny)

function(input, output) {
  output$contents <- renderTable({
    
    # input$file1は、初期状態ではNULL
    # ユーザがアップロードするファイルを選んでから、'name', 'size', 'type',
    # 'datapath'を含むデータフレームになる。
    # 'datapath'は、カレントディレクトリから参照できるローカルなファイル名

    inFile <- input$file1

    if (is.null(inFile))
      return(NULL)
    
    read.csv(inFile$datapath, header=input$header, sep=input$sep, 
                 quote=input$quote)
  })
}

Code license:MIT

  • input$file1は初期状態ではNULLなので、if文でNULLチェック

  • input$file1にファイルが指定されたとき、inFileにファイルのデータフレームが代入される

  • inFileのデータフレームでは、inFile$datapathでファイルへのパスが参照される

  • read.csv()で、header, sep, quoteで指定されたヘッダやセパレータでcsvファイルを開く

ui.R

library(shiny)

fluidPage(
  titlePanel("Uploading Files"),
  sidebarLayout(
    sidebarPanel(
      fileInput('file1', 'Choose CSV File',
                accept=c('text/csv', 
                                 'text/comma-separated-values,text/plain', 
                                 '.csv')),
      tags$hr(),
      checkboxInput('header', 'Header', TRUE),
      radioButtons('sep', 'Separator',
                   c(Comma=',',
                     Semicolon=';',
                     Tab='\t'),
                   ','),
      radioButtons('quote', 'Quote',
                   c(None='',
                     'Double Quote'='"',
                     'Single Quote'="'"),
                   '"')
    ),
    mainPanel(
      tableOutput('contents')
    )
  )
)

Code license:MIT

  • サイドバーに、ファイルアップロードのfileInput()、チェックボックスcheckBoxInput()、ラジオボタンradioButtons()を配置

  • fileInputの引数acceptでMIME(Multipurpose Internet Mail Extension)タイプを指定する。'text/csv', 'text/comma-separated-values,text/plain', '.csv'は、コンマで区切られたcsvファイルを指定している

  • tagsは、HTMLで指定したタグを挿入する関数

Shinyサンプルアプリケーション「08_html」の説明

Shiny

08_htmlは、ui.Rなしで、server.Rで計算した値をHTMLファイルで表示する例です。server.Rは06_tabsetsと全く同じです。

「08_html」の実行

library(shiny)
runExample("08_html")

f:id:phmpk:20161230160208p:plain

server.R

library(shiny)

# ランダムな分布を表示するサーバー側を定義
function(input, output) {
  
  # 分布を生成する
  # 入力が変化したときにreactiveに呼ばれる
  # 下部の出力関数は、ここで生成したreactiveな分布を使用する
  data <- reactive({
    dist <- switch(input$dist,
                   norm = rnorm,
                   unif = runif,
                   lnorm = rlnorm,
                   exp = rexp,
                   rnorm)
    
    dist(input$n)
  })
  
  # dataのプロットとラベルを生成
  # 入力は両方と依存関係があり、どちらかが変化したときはそれに追随して変化する
  output$plot <- renderPlot({
    dist <- input$dist
    n <- input$n
    
    hist(data(), 
         main=paste('r', dist, '(', n, ')', sep=''))
  })
  
  # データのsummaryを生成
  output$summary <- renderPrint({
    summary(data())
  })
  
  # HTMLで表記したデータの表を生成
  output$table <- renderTable({
    data.frame(x=data())
  })
  
}

Code license:MIT

HTML

<html>

<head>
  <script src="shared/jquery.js" type="text/javascript"></script>
  <script src="shared/shiny.js" type="text/javascript"></script>
  <link rel="stylesheet" type="text/css" href="shared/shiny.css"/> 
</head>
 
<body>

  <h1>HTML UI</h1>
 
  <p>
    <label>Distribution type:</label><br />
    <select name="dist">
      <option value="norm">Normal</option>
      <option value="unif">Uniform</option>
      <option value="lnorm">Log-normal</option>
      <option value="exp">Exponential</option>
    </select> 
  </p>
 
  <p>
 
    <label>Number of observations:</label><br /> 
    <input type="number" name="n" value="500" min="1" max="1000" />

  </p>
 
  <pre id="summary" class="shiny-text-output"></pre> 
  
  <div id="plot" class="shiny-plot-output" 
       style="width: 100%; height: 400px"></div> 
  
  <div id="table" class="shiny-html-output"></div>
 
</body>
</html>

Code license:MIT

  • <head></head>でshiny.jsとshiny.css使用を宣言

  • 入力用コントロール<select></select>, <input />で指定したname属性が、server.Rでreactiveな入力input$name, input$nとなる

  • 出力はidとclassを指定して、HTML上に配置する。テキストはshiny-text-ouput、プロットはshiny-plot-output、HTMLの表はshiny-html-outputをclassに指定する