如何根据RadioButton选项是否是正确的选择来更改其颜色？

Question

我目前正在开发一个 R Shiny 应用程序，以培训我们公司的一些 R 新手。使用 Shiny，我想包含多项选择题和选项来测试人们对某些问题的了解。例如下面的问题：

现在，我想要进行的外观更改是，当他们单击/标记正确答案（答案 1）时，正确答案（答案 1）文本将变为绿色。反之亦然，如果选择了错误的答案，颜色就会变成红色。我添加了一个“显示答案”按钮以了解更多背景原因。

我尝试了一些方法，但不起作用。有谁知道如何解决这个问题吗？

代码如下：

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)

Answer 1

创建一个数据框，其中包含原始答案以及通过

HTML

格式化的答案，例如

> 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>

在 observeEvent

 上包含一个 

input$question1（如果选择了某个选项则触发），其中包含一个

ifelse

，它根据

input$question1

的内容从数据框中收集新选项（如果

input$question1

是

choiceValues

） ，采用格式化的选择，否则采用原始的选择）。然后使用

updateRadioButtons

在单选按钮上提供更新的值。

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)

Answer 2

这里有一个 CSS 方法，要求你在 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)