bitWalk's: R Shiny の actionButton (2)

2019-09-02

R Shiny の actionButton (2)

Shiny は R のパッケージの一つで、このパッケージを使うと R を用いて対話的に操作する Web アプリケーションを作成することができます。Web 上のユーザーインタフェース部分を司る ui.R と、内部動作を司る server.R の二つの R 言語スクリプトで、サーバーサイドのコンテンツを作成できることが大きな特徴です。

参考サイト [1] より引用

変数が複数ある場合に actionButton を使う

先のブログ記事 [1] で紹介した actionButton を用いたサンプルは、スライダのひとつの値を server.R 側の eventReactive で受け取り、ヒストグラムに反映させるという単純なものでした。複数の条件でプロットを作成する場合は、server.R 側で observeEvent を使います。

簡単なサンプルですが、二変数で生成するプロットに対して actionButton を用いたサンプルを紹介します。使用した環境は以下の通りです。

OS	Fedora 30 (x86_64)
R	R-core-3.6.0-1.fc30.x86_64
RStudio	rstudio-1.2.1335-1.x86_64
shiny	1.3.2

以下にサンプルを示しました。

リスト: ui.R

fluidPage(
    titlePanel("Iris explorer"),
    sidebarLayout(
        sidebarPanel(
            selectInput(
                inputId = "varX",
                label = "Select the X variable",
                choices = getChoices()),
            selectInput(
                inputId = "varY",
                label = "Select the Y variable",
                choices = getChoices(),
                selected = 2),
            actionButton("goButton", "Plot")
        ),
        mainPanel(
            plotOutput("plot")
        )
    )
)

リスト: server.R

function(input, output) {
    observeEvent(input$goButton, {
        value.x <- iris[, as.numeric(input$varX)]
        value.y <- iris[, as.numeric(input$varY)]
        label.x <- names(iris[as.numeric(input$varX)])
        label.y <- names(iris[as.numeric(input$varY)])
        
        output$plot <- renderPlot({
            p <- ggplot(iris, aes(x = value.x, y = value.y, colour = Species)) + 
                xlab(label.x) + ylab(label.y) + 
                geom_point(size = 4) + gtheme
            plot(p)
        })
    })
}

サンプルをなるべく単純にしたかったので、ここで global.R を使いたくなかったのですが、使った方が全体がシンプルになるので結局使うことにしました。

リスト: global.R

library(shiny)
library(ggplot2)

gtheme <- theme(
  axis.title = element_text(size = 16),
  axis.text = element_text(size = 16),
  axis.line = element_line(),
  legend.title =  element_text(size = 14),
  legend.text = element_text(size = 14),
  panel.grid.major = element_line(colour="grey",size = rel(0.5)), 
  panel.grid.minor = element_blank(), 
  panel.background = element_rect(fill = "whitesmoke")
)

getChoices <- function() {
  return(c("Sepal.Length" = 1, "Sepal.Width" = 2, "Petal.Length" = 3, "Petal.Width" = 4))  
}

このアプリを実行した直後は右側にプロットは表示されません。