I am currently developing an R Shiny App to train some new starters at our company in R. Using Shiny, I want to include multiple choice questions and options to test people on certain questions. For example, the question below:
Now, the cosmetic change I want to make is that when they click/tag the correct answer (Answer 1) that the correct answer (Answer 1) text changes to a green colour. Or vice versa, if the incorrect answer is selected that the colour turns red. I had added a ‘show answer’ button for more context why.
I have tried some things, but it is not working. Is there anyone who has an idea how to fix this?
The code is the following:
library(shiny)
ui <- fluidPage(
mainPanel("What would happen if you ran 6- in the console? Make a guess!",
radioButtons("question1",
label = NULL,
choiceNames = list(HTML("+ sign"),
HTML("6"),
HTML("-6"),
HTML("6-")),
choiceValues = list("text", "text", "text", "text"),
width = 500,
selected = character(0)),
actionButton("answer_button_1", "Show Answer"),
verbatimTextOutput("n_answer_text_1")
)
)
server <- function(input, output) {
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Answers of Question 1
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
n_ans_text_1 <- eventReactive(input$answer_button_1, {
"ANSWER ANSWER"
})
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Render the text of the answers
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
output$n_answer_text_1 <- renderText({n_ans_text_1()})
}
# Run the application
shinyApp(ui = ui, server = server)
Mickiii is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
Create a data frame which contains the raw answers and also the via HTML formatted answers, e.g.
> choiceData
choiceNames choiceValues choicesFormatted
1 + sign ch1 <font color='green'> + sign </font>
2 5 ch2 <font color='red'> 5 </font>
3 -6 ch3 <font color='red'> -6 </font>
4 6- ch4 <font color='red'> 6- </font>
Include an observeEvent on input$question1 (triggers if a choice is selected) containing an ifelse which collects the new choices from the data frame depending on what is input$question1 (if input$question1 is choiceValues, take the formatted choice, else the raw choice). Then use updateRadioButtons for providing the updated values on the radio buttons.
library(shiny)
choiceData <- data.frame(
choiceNames = c("+ sign", "5", "-6", "6-"),
choiceValues = paste0("ch", 1:4),
choicesFormatted = c(HTML("<font color='green'>", "+ sign </font>"),
HTML("<font color='red'>", "5 </font>"),
HTML("<font color='red'>", "-6 </font>"),
HTML("<font color='red'>", "6- </font>")))
ui <- fluidPage(
mainPanel("What would happen if you ran 6- in the console? Make a guess!",
radioButtons("question1",
label = NULL,
choiceNames = choiceData$choiceNames,
choiceValues = choiceData$choiceValues,
width = 500,
selected = character(0)),
actionButton("answer_button_1", "Show Answer"),
verbatimTextOutput("n_answer_text_1")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
observeEvent(input$question1, {
uchoiceNames <- ifelse(choiceData$choiceValues == input$question1,
choiceData$choicesFormatted,
choiceData$choiceNames) |>
lapply(HTML)
updateRadioButtons(
inputId = "question1",
choiceNames = uchoiceNames,
choiceValues = choiceData$choiceValues,
selected = input$question1
)
})
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Answers of Question 1
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
n_ans_text_1 <- eventReactive(input$answer_button_1, {
"ANSWER ANSWER"
})
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Render the text of the answers
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
output$n_answer_text_1 <- renderText({n_ans_text_1()})
}
# Run the application
shinyApp(ui = ui, server = server)
1
Here’s a CSS approach, requiring you to mark the correct answer in the HTML.
library(shiny)
ui <- fluidPage(
tags$style(
HTML(".radio:has(input:checked) .correct { color: green; }"),
HTML(".radio:has(input:checked) { color: red; }"),
),
mainPanel(
radioButtons(
inputId = "question1",
label = "What would happen if you ran 6- in the console? Make a guess!",
choiceNames = list(
span("+ sign", class = "correct"),
span("6"),
span("-6"),
span("6-")
),
choiceValues = list("text", "text", "text", "text"),
selected = character(0)
),
)
)
server <- function(input, output) {}
shinyApp(ui, server)