Shinyで同じ階層構造のUIを連続して生成する～応用編 #R

コードの目的

上記の記事では連続で生成する繰り返し数に関しては静的でしたが、動的に変えています。具体的には以下の動きになります。
・DataTable で複数選択する（範囲は１～４つ）
・actionButtonをクリック
・複数選択した数だけinsertUIでBoxを並べる

2つ選択した場合

4つ選択した場合

コード

app.R

library(shiny,quietly=T,warn.conflicts=F)
library(shinydashboard,quietly=T,warn.conflicts=F)
library(ggplot2,quietly=T,warn.conflicts=F)
library(DT,quietly=T,warn.conflicts=F)

#eventはヘッダーデータのデータフレーム、section_allはトップ階層がリストで対応する詳細データフレームが格納されています
event <- readRDS("event.robj")
section_all <- readRDS("section_all.robj")


ui <- fluidPage(
  dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    dashboardBody(
      actionButton("openSelected","Open selected items"),
      dataTableOutput("dataListDtl")
    )
  )
)
# Server logic
server <- function(input, output, session) {

  output$dataListDtl <- DT::renderDataTable(
    event
  )

  observeEvent(input$openSelected, {
    #前回の選択が残っている可能性があるので削除。時間無かったので適当です、、
    removeUI(selector = "div:has(> #boxid)")
    removeUI(selector = "div:has(> #boxid)")
    removeUI(selector = "div:has(> #boxid)")
    removeUI(selector = "div:has(> #boxid)")
    #Data Tableで選択された数を格納、input～では選択したインデックスが配列で返ってきます
    selected <- length(input$dataListDtl_rows_selected)
    #選択されていない時や5つ以上選択されたら処理を止める
    req(selected > 0 && selected < 5)
    #格納用リストの生成
    sections <- list()
    #以下繰り返し部分のlapply
    lapply(1:selected, function(i) {
      #諸事情でeventとsection_allの行指定が異なるのでちょっと複雑ですが、目的はsectionsにデータフレームを格納することです
      sections[[i]] <- section_all[[event$event_idx[[input$dataListDtl_rows_selected[i]]]]]$sections

      output[[paste0('dtl_pace_plot', i)]] <- renderPlot({
        g <- ggplot(NULL)
        g <- g + geom_path(data = sections[[i]], colour = "blue", aes(x = distance, y = pace))
        g
      })
      output[[paste0('dtl_cadence_plot', i)]] <- renderPlot({
        g <- ggplot(NULL)
        g <- g + geom_path(data = sections[[i]], colour = "blue", aes(x = distance, y = cadence))
        g
      })

      insertUI(
        selector = "#openSelected",
        where = "beforeBegin",
        ui = 
          box(id= "boxid",title = "test",status = "info", collapsible = TRUE,
            solidHeader = TRUE, width = 12 / selected,
            plotOutput(paste0('dtl_pace_plot', i)),
            plotOutput(paste0('dtl_cadence_plot', i))
          )
      )
    })
    return(paste0(selected))
  })

}
shinyApp(ui, server)

説明

適切にreactivityを切る

ここではactionButton/observeEventを使用し、Data Tableを選択した場合のreactivityを切っています。reactivityを適切に切ることでlapply使用時にinsertUIを使用できるようになります。

insertUIによるBox生成部分

今回、req()を使用し、繰り返し数は1～4に規制しています。4を最大にしたのは下記グリッド制約からきれいに割り切れる限界が4なのでそうしています。

width = 12 / selected

の部分は、shinyが横を12分割で使用するため、1つのカラムの幅を指定する部分になります。

boxには後でremoveUIで削除できるようにidを付与しています。今回は雑に同じ名前を付与しています。

removeUIによるUI削除

選択しなおした時に、上記でinsertしたものを削除する処理です。ちゃんとやろうとするならreactiveValueにinsertした要素のID一覧を確認して、、的なほうが美しいですが、面倒だったので最大値の4があっても大丈夫なように回数分つっこんでいます、、。

独り言

実はこのコード、某サービスのプロトのために書いていたものですが、動いたところで「これggplot内で色変えてグラフ重ねたほうが見やすいや、、、」ということで没ったコードです。誰かの役にたちますように、、（ー人ー）