Rshinyでグラフの大きさをユーザーが指定できるように&グラフの描画をボタン押下時のみに。change plot size by user input


グラフの大きさをユーザーが指定できるようにする方法

上の図のように、rshinyアプリ上でグラフ(プロット)の大きさを
ユーザーが指定できるようにしたい場合、以下のようなコードになります。

library(shiny)

# Define UI for app that draws a histogram ----
ui <- fluidPage(
  # App title ----
  titlePanel("Hello Shiny!"),
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    # Sidebar panel for inputs ----
    sidebarPanel(
      # Input: Slider for the number of bins ----
      sliderInput(inputId = "bins",
                  label = "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
      
      ,sliderInput("width","横幅",min=1,max=10,valu=4)
      ,sliderInput("height","縦幅",min=1,max=10,valu=4)
      # ,actionButton("go","グラフ描画")
    ),
    # Main panel for displaying outputs ----
    mainPanel(
      # Output: Histogram ----
      plotOutput(outputId = "distPlot")
    )
  )
)

# Define server logic required to draw a histogram ----
server <- function(input, output) {
  output$distPlot <- renderPlot({
    x    <- faithful$waiting
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = "#75AADB", border = "white",
         xlab = "Waiting time to next eruption (in mins)",
         main = "Histogram of waiting times")
  }
  ,width = reactive(input$width * 100)
  ,height = reactive(input$height * 100)
  )
}
shinyApp(ui = ui, server = server)

UIに横幅と縦幅の入力UIを作り、その値をrenderPlotのwidth,heightプロパティに使っています。
この際、input$width,input$heightをreactiveで囲む必要があるようです。

グラフの描画(再描画)を、ボタン押下時のみに限定する方法


Rshinyでは基本的にグラフは設定と連動してリアルタイムで描画されますが、
グラフ描画に長い時間かかる場合は、グラフの幅やデータの変更に対してその都度グラフの再描画が走ると、
煩わしく感じることがあります。
そこで、UIに明示的に「グラフ描画」ボタンを作り、
そのボタンを押した時のみグラフが描画/再描画されるようにしました。
↓がサンプルコードです。

library(shiny)

# Define UI for app that draws a histogram ----
ui <- fluidPage(
  # App title ----
  titlePanel("Hello Shiny!"),
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    # Sidebar panel for inputs ----
    sidebarPanel(
      # Input: Slider for the number of bins ----
      sliderInput(inputId = "bins",
                  label = "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
      
      ,sliderInput("width","横幅",min=1,max=10,valu=4)
      ,sliderInput("height","縦幅",min=1,max=10,valu=4)
      ,actionButton("go","グラフ描画")
    ),
    # Main panel for displaying outputs ----
    mainPanel(
      # Output: Histogram ----
      plotOutput(outputId = "distPlot")
    )
  )
)

# Define server logic required to draw a histogram ----
server <- function(input, output) {
  myplot <- eventReactive(input$go,{
    x    <- faithful$waiting
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = "#75AADB", border = "white",
         xlab = "Waiting time to next eruption (in mins)",
         main = "Histogram of waiting times")
  })
  output$distPlot <- renderPlot({
    myplot()
  }
  ,width = eventReactive(input$go,{input$width * 100})
  ,height = eventReactive(input$go,{input$height * 100})
  )
}
shinyApp(ui = ui, server = server)

renderPlotの中身とinput$width,input$height
eventReactiveの中に格納することで、ボタン押下のみグラフが更新されるようになっています。

おわり

おわりです。