r语言 - 你如何强迫闪亮的选择输入是数字来计算平均分数?

Question

我有一个闪亮的应用程序，用户可以选择不同的选项("，非常低，低，中，高)，我想给用户一个平均分数基于他们的选择在每个部分以及整体平均(非常低= 1，低= 2等-空白选项应被视为NA)。我知道如果我在一个正常的，无反应的数据集中做这个，我可以使用dplyr的case_when()，但我不确定如何为每个输入做。虽然我对任何解决方案都持开放态度，但我希望使用整洁的函数，特别是case_when()。

实际的调查有30个问题，所以如果可能的话，我宁愿不单独列出每个输入(它们都以类似的词干开头，就像下面的例子一样)。最后，每个平均值应该是一个数字(而不是字符串)，这样我可以稍后进行其他计算。

感谢您的帮助!下面是一个可复制的示例来演示:

library(shiny)
library(tidyverse)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
ui <- fluidPage(
title = "Personalized Quiz",
useShinyjs(),
useShinydashboard(),
tabsetPanel(
tabPanel("Quiz",
sidebarLayout(
sidebarPanel(
h2("Section 1"),
selectInput("q1", "Question 1",
choices = c("", "Very Low", "Low",
"Medium", "High")),
selectInput("q2", "Question 2",
choices = c("", "Very Low", "Low",
"Medium", "High")),
h2("Section 2"),
selectInput("q3", "Question 3",
choices = c("", "Very Low", "Low",
"Medium", "High")),
selectInput("q4", "Question 4",
choices = c("", "Very Low", "Low",
"Medium", "High"))
),
mainPanel(textOutput("section1_results"),
textOutput("section2_results"),
textOutput("overall_results"))
))))

server <- function(input, output) {

section_1 <- reactive({
#create section_1 average here
})

section_2 <- reactive({
#create section_2 average here
})

overall <- reactive({
#create overall average here
})

output$section1_results <- renderText(paste0("Your section 1 average is ", section_1, "."))
output$section2_results <- renderText(paste0("Your section 2 average is ", section_2, "."))
output$overall_results <- renderText(paste0("Your overall average is ", overall, "."))

}
# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

如何解决你的问题;在selectInputs中，您可以像代码中所示的那样为选择分配隐藏值。还要确保在输出中以正确的方式引用您的反应，这意味着您在末尾包含空括号。

library(shiny)
library(tidyverse)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
ui <- fluidPage(
title = "Personalized Quiz",
useShinyjs(),
useShinydashboard(),
tabsetPanel(
tabPanel("Quiz",
sidebarLayout(
sidebarPanel(
h2("Section 1"),
selectInput("q1", "Question 1",
choices = c("", "Very Low" = 1, "Low" = 2,
"Medium" = 3, "High" = 4)),
selectInput("q2", "Question 2",
choices = c("", "Very Low" = 1, "Low" = 2,
"Medium" = 3, "High" = 4)),
h2("Section 2"),
selectInput("q3", "Question 3",
choices = c("", "Very Low" = 1, "Low" = 2,
"Medium" = 3, "High" = 4)),
selectInput("q4", "Question 4",
choices = c("", "Very Low" = 1, "Low" = 2,
"Medium" = 3, "High" = 4)),
),
mainPanel(textOutput("section1_results"),
textOutput("section2_results"),
textOutput("overall_results"))

))))

server <- function(input, output) {

section_1 <- reactive({
#create section_1 average here
mean(c(as.numeric(input$q1), as.numeric(input$q2)), na.rm = T)
})

section_2 <- reactive({
#create section_2 average here
mean(c(as.numeric(input$q3), as.numeric(input$q4)), na.rm = T)
})

overall <- reactive({
#create overall average here
mean(c(as.numeric(input$q1), as.numeric(input$q2), as.numeric(input$q3), as.numeric(input$q4)), na.rm = T)
})

output$section1_results <- renderText(paste0("Your section 1 average is ", section_1(), "."))
output$section2_results <- renderText(paste0("Your section 2 average is ", section_2(), "."))
output$overall_results <- renderText(paste0("Your overall average is ", overall(), "."))


}
# Run the application 
shinyApp(ui = ui, server = server)