将堆叠条形图的值与 R Shiny 中的 table 链接起来

Question

我在 R 中的闪亮应用程序中创建了一个堆叠条形图：


library(shiny)
library(ggplot2)


ui = shinyUI(fluidPage(
  titlePanel("Competency"),
  fluidRow(
    column(6,
           plotOutput("Competency.Name", click = "plot1_click")
    ),
    column(5,
           br(), br(), br(),
           htmlOutput("x_value"),
           verbatimTextOutput("selected_rows"))),
))

server <- function(input, output) {
  
  report <- structure(list(Competency.Official.Rating = structure(c(1L, 2L, 
                                                                    3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 
                                                                    4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 
                                                                    5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L
  ), .Label = c("0", "1", "100", "2", "3"), class = "factor"), 
  Competency.Name = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 
                                2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 
                                5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 8L, 8L, 
                                8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 10L), .Label = c("Agile", 
                                                                                                     "Co-creating the future", "Collaboration", "Entrepreneurship", 
                                                                                                     "Feedback", "Impact", "One company", "One voice", "Responsibility", 
                                                                                                     "Simplification"), class = "factor"), Freq = c(2L, 9L, 308L, 
                                                                                                                                                    221L, 95L, 7L, 76L, 310L, 191L, 51L, 2L, 12L, 308L, 193L, 
                                                                                                                                                    120L, 2L, 43L, 310L, 220L, 60L, 2L, 49L, 311L, 211L, 62L, 
                                                                                                                                                    3L, 58L, 310L, 208L, 56L, 4L, 22L, 312L, 182L, 115L, 3L, 
                                                                                                                                                    11L, 310L, 196L, 115L, 2L, 9L, 309L, 161L, 154L, 3L, 38L, 
                                                                                                                                                    309L, 226L, 59L)), class = "data.frame", row.names = c(NA, 
                                                                                                                                                                                                           -50L))
  
  output$Competency.Name <- renderPlot({
    ggplot(report, aes(x = Competency.Name, y = Freq, fill = Competency.Official.Rating, label = Freq)) +
      geom_bar(stat = "identity") +  # position = fill will give the %; stack will give #of people
      geom_text(size = 3, position = position_stack(vjust = 0.5))   
  })
  
  # Print the name of the x value
  output$x_value <- renderText({
    if (is.null(input$plot1_click$x)) return("")
    else {
      lvls <- levels(report$Competency.Name)
      name <- lvls[round(input$plot1_click$x)]
      HTML("You've selected <code>", name, "</code>",
           "<br><br>Here are the first 10 rows that ",
           "match that category:")
    }
  })
  
  # Print the rows of the data frame which match the x value
  output$selected_rows <- renderPrint({
    if (is.null(input$plot1_click$x)) return()
    else {
      keeprows <- round(input$plot1_click$x) == as.numeric(report$Competency.Name)
      head(report[keeprows, ], 10)
    }
  })
}

shinyApp(ui, server)

在应用程序中，当我 select 我的条形图上的一列时，它显示整个条形图的 table （事实上，它是一个具有不同值的堆叠条形图，没有考虑在内通过我的代码）。在 table 中，我只想查看 selected 堆栈的值。我知道在这个例子中它没有男性意义，但我有一个更大的 table 和更多的变量，我可以在那里使用这个修改。

谢谢！

Answer 1

您需要计算输入的累积总和，然后您可以将其与 input$plot1_click$y 进行比较，如下所示：

library(shiny)
library(ggplot2)
library(dplyr)
report <- structure(
  list(Competency.Official.Rating = 
         structure(c(1L, 2L,
                     3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L,
                     4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L,
                     5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L
         ), .Label = c("0", "1", "100", "2", "3"), class = "factor"),
       Competency.Name = 
         structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L,
                     2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L,
                     5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 8L, 8L,
                     8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 10L), 
                   .Label = 
                     c("Agile",
                       "Co-creating the future", "Collaboration", "Entrepreneurship",
                       "Feedback", "Impact", "One company", "One voice", 
                       "Responsibility", "Simplification"), class = "factor"), 
       Freq = c(2L, 9L, 308L,
                221L, 95L, 7L, 76L, 310L, 191L, 51L, 2L, 12L, 308L, 193L,
                120L, 2L, 43L, 310L, 220L, 60L, 2L, 49L, 311L, 211L, 62L,
                3L, 58L, 310L, 208L, 56L, 4L, 22L, 312L, 182L, 115L, 3L,
                11L, 310L, 196L, 115L, 2L, 9L, 309L, 161L, 154L, 3L, 38L,
                309L, 226L, 59L)), class = "data.frame", 
  row.names = c(NA,
                -50L))

report_stats <- report %>% 
  arrange(Competency.Name, desc(Competency.Official.Rating)) %>% 
  group_by(Competency.Name) %>% 
  mutate(cumsum = cumsum(Freq))

ui = shinyUI(fluidPage(
  titlePanel("Competency"),
  fluidRow(
    column(6,
           plotOutput("Competency.Name", click = "plot1_click")
    ),
    column(5,
           br(), br(), br(),
           htmlOutput("x_value"),
           verbatimTextOutput("selected_rows"))),
))

server <- function(input, output) {
  
  x_val <- reactive({
    x <- req(input$plot1_click$x)
    lvls <- levels(report$Competency.Name)
    lvls[round(input$plot1_click$x)]
  })
  
  y_val <- reactive({
    x <- req(x_val())
    y <- req(input$plot1_click$y)
    report_stats %>% 
      filter(Competency.Name == x,
             y <= cumsum) %>% 
      slice(1L) %>% 
      pull(Competency.Official.Rating)
  })
  
  output$Competency.Name <- renderPlot({
    ggplot(report, aes(x = Competency.Name, y = Freq, 
                       fill = Competency.Official.Rating, label = Freq)) +
      geom_bar(stat = "identity") + 
      geom_text(size = 3, position = position_stack(vjust = 0.5))
  })
  
  # Print the name of the x value
  output$x_value <- renderText({
    HTML("You've selected <code>", req(x_val()), "</code>",
         "<br><br>Here are the first 10 rows that ",
         "match that category:")
    
  })
  
  # Print the rows of the data frame which match the x value
  output$selected_rows <- renderPrint({
    x <- req(x_val())
    y <- req(y_val())
    head(report[report$Competency.Name == x & report$Competency.Official.Rating == y, ], 10)
  })
}

shinyApp(ui, server)

将堆叠条形图的值与 R Shiny 中的 table 链接起来

Linking values of stacked barplot with a table in R Shiny

r

shiny

stacked-chart