はじめに
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つの個体値合計を、横軸に最重要なパラメータである素早さをプロットします。散布図中にプロットされる点は、上の表に表示されているポケモン一覧で、選択されたポケモンにはラベルが付きます。
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の表示
DTはdata.frameをインタラクティブな表として出力するためのライブラリです。チュートリアルには含まれていませんが、ソートや表示数の設定などが可能で、データ内容を確認するのに便利です。
使用方法は、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_pointやgeom_labelを上書きしていくときには、下記のようにggplot()+...と記述します。
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月時点)。
hinyapps.ioにsign up
rsconnectをインストール(
install.packages('rsconnect'))rsconnectでshinyappsに接続します。ブラウザからshinyappsを操作すると、クリップボードに
name, token, secretを含んだrsconnect::setAccountInfo(name="<ACCOUNT>", token="<TOKEN>", secret="<SECRET>")というコマンドがコピーされるので、コンソールから入力します。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"]) }) })
