Hello!
I'm working on a shiny app where users will be a table. Each row in the table corresponds to a topic, and each column corresponds to a proficiency levels. Users will select their proficiency level for each of the topics. Because of how the proficiency levels work, choosing a level implies all lower levels have been surpassed. For example, selecting Level 3 implies that this user has passed Level 1 and Level 2.
Where I'm hoping to get some help...In practice, there were a block of text describing the skills involved for each topic and proficiency level. I'm hoping that I can allow users to select the entire cell of the table. Currently, I've only been able to add check boxes within each cell of the table. The problem is that the text descriptions will have different lengths (and therefore different numbers of lines), which makes it difficult to vertically and horizontally align all of the check boxes.
My shiny skills are fairly elementary, but I'm hoping more advanced shiny users may have some insight into how to do this.
A reprex is included below.
Thanks!
Jeff
library(shiny)
library(DT)
library(glue)
library(tidyverse)
library(here)
linebreaks <- function(n){HTML(strrep(br(), n))}
linebreaks_descriptors <- function(desc){HTML}
levels = c("Level 1", "Level 2", "Level 3", "Level 4")
categories <- c("Category 1", "Category 2", "Category 3")
shinyApp(
ui = fluidPage(
tags$head(
tags$style(type="text/css", " .checkbox-inline { position: relative; padding-left: 40px; margin-left: 40px} input[type='checkbox']{ position: relative; vertical-align: middle; display: inline-block; margin-top: 22px;} label{ position: relative; display: table-cell; text-align: left; vertical-align: middle; } #inline .form-group { position: relative; display: table-row; } input[type='checkbox']{ position: relative; vertical-align: middle; display: inline-block;}")
),
fluidRow(
column(11, offset = 0,
selectInput(inputId = "category_select",
label = "Select category",
choices = categories))
),
fluidRow(),
fluidRow(),
fluidRow(
column(11, offset = 0,
tags$div(id = "inline", uiOutput("checkbox1")))
),
fluidRow(p(linebreaks(1))),
fluidRow(
column(11, offset = 0,
tags$div(id = "inline", uiOutput("checkbox2")))
),
fluidRow(p(linebreaks(1))),
fluidRow(
column(11, offset = 0,
tags$div(id = "inline", uiOutput("checkbox3")))
),
fluidRow(p(linebreaks(1))),
fluidRow(column(11, offset = 0,
htmlOutput("overall_level")))
),
server = function(input, output, session) {
level_descriptors <- reactiveValues(topic1 = NULL, topic2 = NULL,
topic3 = NULL)
level_descriptors$topic1 <- list(HTML("Level 1<br/>Description<br/>Text"),
HTML("Level 2<br/>Description<br/>Text"),
HTML("Level 3<br/>Description<br/>Text"),
HTML("Level 4<br/>Description<br/>Text"))
level_descriptors$topic2 <- list(HTML("Level 1<br/>Description<br/>Text"),
HTML("Level 2<br/>Description<br/>Text"),
HTML("Level 3<br/>Description<br/>Text"),
HTML("Level 4<br/>Description<br/>Text"))
level_descriptors$topic3 <- list(HTML("Level 1<br/>Description<br/>Text"),
HTML("Level 2<br/>Description<br/>Text"),
HTML("Level 3<br/>Description<br/>Text"),
HTML("Level 4<br/>Description<br/>Text"))
output$checkbox1 <- renderUI({
checkboxGroupInput("checkbox_topic1", "Topic 1", selected = NULL,
inline = TRUE,
choiceNames = level_descriptors$topic1,
choiceValues = c(1, 2, 3, 4),
width = 10)
})
output$checkbox2 <- renderUI({
checkboxGroupInput("checkbox_topic2", "Topic 2", selected = NULL,
inline = TRUE,
choiceNames = level_descriptors$topic2,
choiceValues = c(1, 2, 3, 4),
width = "10px")
})
output$checkbox3 <- renderUI({
checkboxGroupInput("checkbox_topic3", "Topic 3", selected = NULL,
inline = TRUE,
choiceNames = level_descriptors$topic3,
choiceValues = c(1, 2, 3, 4))
})
select_topic1 <- reactiveValues(levels = NULL)
observeEvent(input$checkbox_topic1, {
select_topic1$levels <- input$checkbox_topic1
select_topic1$levels <- as.numeric(select_topic1$levels)
select_topic1$levels <- max(select_topic1$levels)
select_topic1$levels <- 1:select_topic1$levels
})
select_topic2 <- reactiveValues(levels = NULL)
observeEvent(input$checkbox_topic2, {
select_topic2$levels <- input$checkbox_topic2
select_topic2$levels <- as.numeric(select_topic2$levels)
select_topic2$levels <- max(select_topic2$levels)
select_topic2$levels <- 1:select_topic2$levels
})
select_topic3 <- reactiveValues(levels = NULL)
observeEvent(input$checkbox_topic3, {
select_topic3$levels <- input$checkbox_topic3
select_topic3$levels <- as.numeric(select_topic3$levels)
select_topic3$levels <- max(select_topic3$levels)
select_topic3$levels <- 1:select_topic3$levels
})
observe({
updateCheckboxGroupInput(
session, "checkbox_topic1",
choiceNames = level_descriptors$topic1,
choiceValues = c(1, 2, 3, 4),
inline = TRUE,
selected = select_topic1$levels
)
updateCheckboxGroupInput(
session, "checkbox_topic2",
choiceNames = level_descriptors$topic2,
choiceValues = c(1, 2, 3, 4),
inline = TRUE,
selected = select_topic2$levels
)
updateCheckboxGroupInput(
session, "checkbox_topic3",
choiceNames = level_descriptors$topic3,
choiceValues = c(1, 2, 3, 4),
inline = TRUE,
selected = select_topic3$levels
)
})
max_topic1 <- reactiveValues(levels = NULL)
observeEvent(input$checkbox_topic1, {
max_topic1$levels <- input$checkbox_topic1
max_topic1$levels <- as.numeric(max_topic1$levels)
max_topic1$levels <- max(max_topic1$levels)
})
max_topic2 <- reactiveValues(levels = NULL)
observeEvent(input$checkbox_topic2, {
max_topic2$levels <- input$checkbox_topic2
max_topic2$levels <- as.numeric(max_topic2$levels)
max_topic2$levels <- max(max_topic2$levels)
})
max_topic3 <- reactiveValues(levels = NULL)
observeEvent(input$checkbox_topic3, {
max_topic3$levels <- input$checkbox_topic3
max_topic3$levels <- as.numeric(max_topic3$levels)
max_topic3$levels <- max(max_topic3$levels)
})
output$overall_level <- renderText({
total_levels <- sum(max_topic1$levels,
max_topic2$levels,
max_topic3$levels,
na.rm = TRUE)
if (total_levels < 3) {
"<h2 style='font-size: 120%;'><b>Performance Level:</b> Level 1 </h2>"
} else if (total_levels < 6) {
"<h2 style='font-size: 120%;'><b>Performance Level:</b> Level 2 </h2>"
} else if (total_levels < 9) {
"<h2 style='font-size: 120%;'><b>Performance Level:</b> Level 3 </h2>"
} else {
"<h2 style='font-size: 120%;'><b>Performance Level:</b> Level 4 </h2>"
}
})
}
)