Linking values of stacked barplot with a table in R Shiny - r

Question

I have created a stacked barplot in the shiny app in 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)
In the app, when I select a column on my barplot it shows the table for the whole bar (the fact that it is a stacked barplot with different values is not taken in account by my code). In the table I would like to see values only for a selected stack. I know in this example it does not male sense but I have a bigger table with more variables and I could use this modification there.
Thank you!

Answer 1

You need to calculate the cumulative sum of your input and then you can compare it to input$plot1_click$y like this:
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)