ShinyBSで折りたたみパネルUIを作る＆パネルのヘッダーのクリック範囲をヘッダー全体に広げる

折りたたみパネルUIのためのパッケージshinyBS

RShinyアプリケーションを作る際に便利なパッケージとして、
shinyBSパッケージがあります。
https://ebailey78.github.io/shinyBS/

その中で特に便利なのが、bsCollapse関数です。
https://ebailey78.github.io/shinyBS/docs/Collapses.html
これを利用すると、↓のような折りたたみ式のパネルUIを簡単に作ることができます。

最初は手順１が開いている。手順２と３は折りたたまれている

↓（手順２のヘッダーをクリックすると、手順２が開いて、手順１は折りたたまれる

このように、余計なUIを見せずに手順を進められるので、
ユーザーが混乱しにくいと思われます。

まあShinydashboardを使えば同じことは簡単にできるのですが、
使わなくても折りたたみパネルが作れるよということで。

上記公式サイトにサンプルがあるので、転記しておきます。（動作確認ずみ）

library(shiny)
library(shinyBS)

shinyApp(
  ui =
    fluidPage(
      sidebarLayout(
        sidebarPanel(HTML("This button will open Panel 1 using updateCollapse."),
                     actionButton("p1Button", "Push Me!"),
                     selectInput("styleSelect", "Select style for Panel 1",
                                 c("default", "primary", "danger", "warning", "info", "success"))
        ),
        mainPanel(
          bsCollapse(id = "collapseExample", open = "Panel 2",
                     bsCollapsePanel("Panel 1", "This is a panel with just text ",
                                     "and has the default style. You can change the style in ",
                                     "the sidebar.", style = "info"),
                     bsCollapsePanel("Panel 2", "This panel has a generic plot. ",
                                     "and a 'success' style.", plotOutput("genericPlot"), style = "success")
          )
        )
      )
    ),
  server =
    function(input, output, session) {
      output$genericPlot <- renderPlot(plot(rnorm(100)))
      observeEvent(input$p1Button, ({
        updateCollapse(session, "collapseExample", open = "Panel 1")
      }))
      observeEvent(input$styleSelect, ({
        updateCollapse(session, "collapseExample", style = list("Panel 1" = input$styleSelect))
      }))
    }
)

ヘッダーのクリック範囲をヘッダー全体に広げる

便利なbsCollapseですが、１つだけ欠点があります。
それは、デフォルト設定だとパネルを広げるときにクリックするヘッダーが
「文字のみ」になっているという点です。
つまり下図↓の②のあたりをクリックしても反応せず、①をクリックしなければなりません。
これはちょっと不便です。

対策を調べてみると、パッケージのgithubで解決策が出ていました。
https://github.com/ebailey78/shinyBS/issues/122
以下のCSSをcuntom.cssに追加するか、Rのコード内に直接記述すればOKとのことです。

.panel.title>a {
  display: block;
  padding: 10px 15px;
  margin: -10px -15px;
}

自分の場合はcssを別ファイルにするのが面倒なので、
shinyjsパッケージを使ってコード内で記述しました。以下、改良したサンプルコードです。

library(shiny)
library(shinyBS)
library(shinyjs)

shinyApp(
  ui =
    fluidPage(
      useShinyjs()
      ,inlineCSS(list(
        ".panel-title>a"="
          display: block;
          padding: 10px 15px;
          margin: -10px -15px;
        "
      ))
      
      ,sidebarLayout(
        sidebarPanel(HTML("This button will open Panel 1 using updateCollapse."),
                     actionButton("p1Button", "Push Me!"),
                     selectInput("styleSelect", "Select style for Panel 1",
                                 c("default", "primary", "danger", "warning", "info", "success"))
        ),
        mainPanel(
          bsCollapse(id = "collapseExample", open = "Panel 2",
                     bsCollapsePanel("Panel 1", "This is a panel with just text ",
                                     "and has the default style. You can change the style in ",
                                     "the sidebar.", style = "info"),
                     bsCollapsePanel("Panel 2", "This panel has a generic plot. ",
                                     "and a 'success' style.", plotOutput("genericPlot"), style = "success")
          )
        )
      )
    ),
  server =
    function(input, output, session) {
      output$genericPlot <- renderPlot(plot(rnorm(100)))
      observeEvent(input$p1Button, ({
        updateCollapse(session, "collapseExample", open = "Panel 1")
      }))
      observeEvent(input$styleSelect, ({
        updateCollapse(session, "collapseExample", style = list("Panel 1" = input$styleSelect))
      }))
    }
)

以上、Shinyで折りたたみパネルUIを作る方法でした。