Rで解析：Shinyで習作４「プロットからデータをインタラクティブに取得」

Shinyの習作、その４です。出力したプロットからインタラクティブにデータを取得する例です。

RStudioのversion 2022.12.0 Build 353。R version 4.2.2で動作を確認しています。

コマンドの紹介

詳細はコマンド、各パッケージのヘルプを確認してください。実行コマンドが短いのでui.Rとserver.Rに分けずに紹介します。コンソールにペーストして実行すると動作します。

#&#12497;&#12483;&#12465;&#12540;&#12472;&#12398;&#35501;&#12415;&#36796;&#12415;
if (!require("shiny")) {
  install.packages("shiny")}
if (!require("ggplot2")) {
  install.packages("ggplot2")}

###&#12487;&#12540;&#12479;&#20363;&#12398;&#20316;&#25104;#####
n <- 50
TestData <- data.frame("Group" = sample(paste0("Group", 1:5), n, replace = TRUE),
                       "Data1" = sample(1:10, n, replace = TRUE),
                       "Data2" = sample(1:10, n, replace = TRUE))
########

#GUI&#35373;&#23450;
ui <- fluidPage(
  
  fluidRow(
    #fluidRow&#20869;&#12395;&#35352;&#36848;&#12377;&#12427;&#12392;&#27178;&#20006;&#12403;
    column(width = 4,
           #ggplot&#12434;&#12503;&#12525;&#12483;&#12488;
           plotOutput("ggplot", height = 300,
                      #plot&#12434;&#12452;&#12531;&#12479;&#12521;&#12463;&#12486;&#12451;&#12502;&#12395;&#36984;&#25246;&#12377;&#12427;:brushOpts&#12458;&#12503;&#12471;&#12519;&#12531;
                      #&#36984;&#25246;&#12456;&#12522;&#12450;&#12398;&#22615;&#33394;&#12434;&#25351;&#23450;:fill&#12458;&#12503;&#12471;&#12519;&#12531;
                      brush = brushOpts(
                        id = "plot_brush", fill = "yellow"
                      )
           )),
    column(width = 4,
           #barplot&#12434;&#12503;&#12525;&#12483;&#12488;
           plotOutput("barplot", height = 300)
    )
  ),
  fluidRow(
    column(width = 4,
           p("&#36984;&#25246;&#31684;&#22258;&#12395;&#21547;&#12414;&#12428;&#12427;&#24773;&#22577;"),
           #&#20966;&#29702;&#32080;&#26524;&#12434;&#25972;&#24418;&#12375;&#12390;&#20986;&#21147;:verbatimTextOutput&#12467;&#12510;&#12531;&#12489;
           verbatimTextOutput("brushData")
    )
  )
)

#&#20966;&#29702;&#20869;&#23481;&#35373;&#23450;
server <- function(input, output) {
  #ggplot2&#20966;&#29702;
  output$ggplot <- renderPlot({
    ggplot(TestData, aes(Data2, Data1)) +
      geom_point(aes(col = topo.colors(nrow(TestData)))) +
      guides(colour = FALSE)
  })
  #barplot&#20966;&#29702;
  output$barplot <- renderPlot({
    if(length(GetData()[, 1]) >= 1){
      barplot(xtabs(~as.character(GetData()[, 1])), col = topo.colors(5))
    }else{}
  })
  #&#36984;&#25246;&#31684;&#22258;&#12398;&#12487;&#12540;&#12479;&#20986;&#21147;
  output$brushData <- renderPrint({
    brushedPoints(GetData(), input$plot_brush)
  })
  #&#36984;&#25246;&#31684;&#22258;&#12398;&#12487;&#12540;&#12479;&#12434;&#21462;&#24471;
  GetData <- reactive({
    brushedPoints(TestData, input$plot_brush)
  })
}

#shiny&#12450;&#12503;&#12522;&#36215;&#21205;
shinyApp(ui, server)

実行例

・Chromeでの実行例です。

少しでも、あなたの解析が楽になりますように！！